10:00 AM 27-OCT-97 MHSS VERSION 2.0 PATCH 1 AMHLE AMHLE ; IHS/TUCSON/LAB - MENTAL HLTH ROUTINE 16-AUG-1994 ; [ 10/06/97 10:57 AM ] ;;2.0;IHS MENTAL HLTH/SOC SERV;**1**;JUN 24, 1997 ;; ; ;CMI/TUCSON/LAB - 10/06/97 - PATCH 1 reformat header START ; Write Header D EN^AMHEKL ; -- kill all vars before starting W:$D(IOF) @IOF F J=1:1:5 S X=$P($T(TEXT+J),";;",2) W !?80-$L(X)\2,X K X,J W !! D ^AMHLEIN ;Initialize vars, etc. ;loop through until user wants to quit S AMHPTYPE="" D GETTYPE Q:AMHPTYPE="" S AMHDATE="" F D GETDATE Q:AMHDATE="" D EN,FULL^VALM1,EXIT D EOJ Q ; EOJ ;EOJ CLEANUP D CLEAR^VALM1 D EN^AMHEKL Q GETTYPE ;EP I $G(AMHPATCE) D FULL^VALM1 W:$D(IOF) @IOF S AMHPTYPE="" W !,"Please enter the appropriate set of defaults to be used in Data entry.",!,"This applies to default clinic, location, community and program.",! S DIR(0)="S^M:MENTAL HEALTH DEFAULTS;S:SOCIAL SERVICES DEFAULTS",DIR("A")="Which set of defaults do you want to use in Data Entry" K DA D ^DIR K DIR Q:$D(DIRUT) S AMHPTYPE=Y Q GETDATE ;EP - GET DATE OF ENCOUNTER W !! S AMHDATE="",DIR(0)="DO^:"_DT_":EPTX",DIR("A")="Enter ENCOUNTER DATE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 Q:$D(DIRUT) S AMHDATE=Y Q EN ; EP -- main entry point for AMH UPDATE ACTIVITY RECORDS S AMHKDTIM=DTIME S:DTIME<3600 DTIME=3600 S VALMCC=1 D EN^VALM("AMH UPDATE ACTIVITY RECORDS") D CLEAR^VALM1 S DTIME=AMHKDTIM K AMHKDTIM Q ; HDR ;EP -- header code S VALMHDR(1)=AMHDASH S VALMHDR(2)="Date of Encounter: "_$$FTIME^VALM1(AMHDATE) S VALMHDR(3)=AMHDASH I $E($G(^TMP("AMHVRECS",$J,1,0)))="N" S AMHRCNT=0,VALMHDR(4)=^TMP("AMHVRECS",$J,1,0) K ^TMP("AMHVRECS",$J) E S VALMHDR(4)=" # PRV PATIENT NAME HRN LOC AT ACT PROB NARRATIVE" ;CMI/TUCSON/LAB patch 1 10/06/97 - reformat header Q ; INIT ;EP -- init variables and list array S VALMSG="Q - Quit ?? for more actions + next screen - prev screen" D GATHER^AMHLEL ;gather up all records for display S VALMCNT=AMHRCNT Q ; HELP ;EP -- help code S X="?" D DISP^XQORM1 W !! Q ; EXIT ; -- exit code K AMHRCNT,^TMP("AMHVRECS",$J) K VALMCC,VALMHDR Q ; EXPND ; -- expand code Q ; TEXT ; ;;MH/SS Data Entry Module ;; ;;************************ ;;* Update MH/SS Records * ;;************************ ;; Q AMHLEFPP AMHLEFPP ; IHS/TUCSON/LAB - MENTAL HLTH ROUTINE ; [ 09/22/97 10:56 AM ] ;;2.0;IHS MENTAL HLTH/SOC SERV;**1**;JUN 24, 1997 ; ;CMI/TUCSON/LAB - added setting of % variable 9/22/97 ; I AMHEFT="B" S AMHEFT="S" D PRINT1 Q:AMHQUIT S AMHEFT="F" D PRINT1 K AMHEFT Q I AMHEFT="T" S AMHEFT="S" D PRINT1 Q:AMHQUIT S AMHEFT="S" D PRINT1 K AMHEFT Q I AMHEFT="E" S AMHEFT="F" D PRINT1 Q:AMHQUIT S AMHEFT="F" D PRINT1 K AMEFT Q PRINT1 ;EP - CALLED FROM LAST VISIT DISPLAY S AMHR0=^AMHREC(AMHR,0) S AMHQUIT=0 I $E(IOST,1,2)'="P-" W:$D(IOF) @IOF W !!?13,"********** CONFIDENTIAL PATIENT INFORMATION **********" W !?15,"PCC MENTAL HEALTH/SOCIAL SERVICES ENCOUNTER RECORD" W !?18,"*** Computer Generated Encounter Record ***" W !!,$TR($J("",80)," ","*") I $Y>(IOSL-5) D FF Q:AMHQUIT W !!?3,"Date: " S Y=$P($P(AMHR0,U),".") D DD^%DT W Y W ?31,"Primary Provider: ",$$PPNAME^AMHUTIL(AMHR) S AMHX=0 F S AMHX=$O(^AMHRPROV("AD",AMHR,AMHX)) Q:AMHX'=+AMHX!(AMHQUIT) I $P(^AMHRPROV(AMHX,0),U,4)'="P" W !?35,$P(^VA(200,$P(^AMHRPROV(AMHX,0),U),0),U) I $Y>(IOSL-5) D FF Q:AMHQUIT TIME W !?3,"Arrival Time: " S Y=$P(AMHR0,U) D DD^%DT W $P(Y,"@",2) I $P(AMHR0,U,27)]"" W ?31,"Flag: ",$P(AMHR0,U,27) W !?3,"Program: ",$$EXTSET^XBFUNC(9002011,.02,$P(AMHR0,U,2)) W !?3,"Clinic: " I $P(AMHR0,U,25) W $P(^DIC(40.7,$P(AMHR0,U,25),0),U) W !?3,"Appointment Type: ",$$EXTSET^XBFUNC(9002011,.11,$P(AMHR0,U,11)) W !,$TR($J("",80)," ","_") COMM ; I $Y>(IOSL-7) D FF Q:AMHQUIT W !?53,"Number",?64,"Activity/Service" W !?3,"Community: " W:$P(AMHR0,U,5) $E($P(^AUTTCOM($P(AMHR0,U,5),0),U),1,15) W ?32,"Activity: " I $P(AMHR0,U,6) W $P(^AMHTACT($P(AMHR0,U,6),0),U),"-",$P(^AMHTACT($P(AMHR0,U,6),0),U,8) W ?53,"Served: ",$P(AMHR0,U,9),?64,"Time: ",$P(AMHR0,U,12) W !?32,"Type of Contact: " I $P(AMHR0,U,7) W $P(^AMHTSET($P(AMHR0,U,7),0),U) W !,$TR($J("",80)," ","_") I $Y>(IOSL-4) D FF Q:AMHQUIT W !?3,"CHIEF COMPLAINT: " I AMHEFT="F" S AMHTICL=18,AMHTNRQ=$G(^AMHREC(AMHR,21)),AMHTTXT="" D PRTTXT I AMHEFT="S" W !?3,"Chief Complaint Suppressed for Confidentiality",! SUB W !?3,"SUBJECTIVE/OBJECTIVE: ",! I AMHEFT="F" S AMHX=0 F S AMHX=$O(^AMHREC(AMHR,31,AMHX)) Q:AMHX'=+AMHX!(AMHQUIT) D .I $Y>(IOSL-6) D FF Q:AMHQUIT .W !?4,^AMHREC(AMHR,31,AMHX,0) .Q I AMHEFT="S" W ?3,"Mental Health or Social Services Contact",!?3,"See ",$$PPNAME^AMHUTIL(AMHR)," for details.",! I $Y>(IOSL-5) D FF Q:AMHQUIT I $D(^AMHREC(AMHR,61))!($P(AMHR0,U,14)]"") D Q:AMHQUIT .I $Y>(IOSL-5) D FF Q:AMHQUIT .W !,$TR($J("",80)," ","_") .W !?3,"AXIS IV: " S Y=0 F S Y=$O(^AMHREC(AMHR,61,Y)) Q:Y'=+Y S I=$P(^AMHREC(AMHR,61,Y,0),U) W ?14,$P(^AMHTAXIV(I,0),U)_" - "_$P(^AMHTAXIV(I,0),U,2),! .W ?3,"AXIS V: ",$P(AMHR0,U,14) .Q W !,$TR($J("",80)," ","_") W !?3,"MH/SS POV CODE PURPOSE OF VISIT (POV)",!?3,"OR DSM DIAGNOSIS [PRIMARY ON FIRST LINE]" W !,$TR($J("",80)," ","_") POV ; S (AMHX,AMHC)=0 F S AMHX=$O(^AMHRPRO("AD",AMHR,AMHX)) Q:AMHX'=+AMHX!(AMHQUIT) D .I $Y>(IOSL-3) D FF Q:AMHQUIT .W !?8,$P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U) .S AMHTNRQ=$S(AMHEFT="F":$P(^AMHPROB($P(^AMHRPRO(AMHX,0),U),0),U,2),1:""),AMHTICL=23,AMHTTXT="" D PRTTXT .S AMHTNRQ=$P(^AMHRPRO(AMHX,0),U,4) S AMHTNRQ=$S(AMHTNRQ]"":$P(^AUTNPOV(AMHTNRQ,0),U),1:"<>"),AMHTICL=23,AMHTTXT="" D PRTTXT .S AMHC=AMHC+2 .Q Q:AMHQUIT F I=AMHC:1:3 D:$Y>(IOSL-3) FF Q:AMHQUIT W ! D:$Y>(IOSL-3) FF Q:AMHQUIT W !,$TR($J("",80)," ","_") INPT ; I $P(AMHR0,U,17)]"" D Q:AMHQUIT .I $Y>(IOSL-4) D FF Q:AMHQUIT .W ?3,"Inpatient Disposition: ",$$EXTSET^XBFUNC(9002011,.17,$P(AMHR0,U,17)),!?3,"Facility: ",$P(AMHR0,U,18) .W !,$TR($J("",80)," ","_") .Q TMP ;treated med problems W !?3,"TREATED MEDICAL PROBLEMS:" S (AMHX,AMHC)=0 F S AMHX=$O(^AMHRTMDP("AD",AMHR,AMHX)) Q:AMHX'=+AMHX!(AMHQUIT) D .I $Y>(IOSL-3) D FF Q:AMHQUIT .W !?8,$P(^AUTNPOV($P(^AMHRTMDP(AMHX,0),U),0),U) .Q W !,$TR($J("",80)," ","_") MEDS ; W !?3,"MEDICATIONS PRESCRIBED:" S AMHX=0 F S AMHX=$O(^AMHREC(AMHR,41,AMHX)) Q:AMHX'=+AMHX!(AMHQUIT) D .I $Y>(IOSL-3) D FF Q:AMHQUIT .W !?4,^AMHREC(AMHR,41,AMHX,0) .Q W !,$TR($J("",80)," ","_") PROC ; W !?3,"PROCEDURES (CPT):" S (AMHX,AMHC)=0 F S AMHX=$O(^AMHRPROC("AD",AMHR,AMHX)) Q:AMHX'=+AMHX!(AMHQUIT) D .I $Y>(IOSL-3) D FF Q:AMHQUIT .W !?8,$P(^ICPT($P(^AMHRPROC(AMHX,0),U),0),U)," ",$P(^ICPT($P(^AMHRPROC(AMHX,0),U),0),U,2) .Q COMMENT ; W !,$TR($J("",80)," ","_") I $Y>(IOSL-4) D FF Q:AMHQUIT S %="" W !?3,"COMMENT:",! ;CMI/TUCSON/LAB - added setting of % 09/22/97 I AMHEFT="S",$P($G(^AMHSITE(DUZ(2),0)),U,27)'="N" S %=0 I AMHEFT="F" S %=1 I AMHEFT="S",$P($G(^AMHSITE(DUZ(2),0)),U,27)="N" S %=1 I '% W ! I % D .S AMHTICL=4,AMHTNRQ=$G(^AMHREC(AMHR,12)),AMHTTXT="" .I AMHTNRQ]"" D PRTTXT W !,$TR($J("",80)," ","_") DEMO ;EP demographics D DEMO^AMHLEFP1 Q PRTTXT ; GENERALIZED TEXT PRINTER S AMHTDLT=1,AMHTILN=80-AMHTICL-1 F AMHTQ=0:0 S:AMHTNRQ]""&(($L(AMHTNRQ)+$L(AMHTTXT)+2)<255) AMHTTXT=$S(AMHTTXT]"":AMHTTXT_"; ",1:"")_AMHTNRQ,AMHTNRQ="" Q:AMHTTXT="" D PRTTXT2 K AMHTILN,AMHTDLT,AMHTF,AMHTC,AMHTTXT,AMHTDOO Q PRTTXT2 D GETFRAG W ?AMHTICL W AMHTF,! S AMHTICL=AMHTICL+AMHTDLT,AMHTILN=AMHTILN-AMHTDLT,AMHTDLT=0 Q GETFRAG I $L(AMHTTXT)DT W " ",$C(7),$C(7) K X G GETDATE S AMHDATE=Y GETPROG ; S AMHPROG="" K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="SB^M:Mental Health;S:Social Services;O:Other",DIR("A")="Enter PROGRAM" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 G:$D(DIRUT) GETDATE S AMHPROG=Y,AMHPROG(0)=Y(0),AMHPTYPE=Y GETCLN ; S AMHCLN="",DIC="^DIC(40.7,",DIC(0)="AEMQ",DIC("A")="Enter CLINIC (not required): " D ^DIC K DIC I X="" S AMHCLN="" G GETTOD G:Y<0 GETPROG S AMHCLN=+Y GETTOD ; S AMHDATE=$P(AMHDATE,".") S AMHTOD="12:00" W !,"ARRIVAL Time: ",$S(AMHTOD]"":AMHTOD_"// ",1:"") R X:$S($D(DTIME):DTIME,1:300) S:'$T X="^" S:X="" X=AMHTOD I X="^" G GETCLN I X="" S AMHTOD="12:00" G EDTIME I X["?" W !,"Enter time of arrival, or 'D' for default." G GETTOD I X="D" S X="12:00" W " ",X S AMHTOD=X EDTIME S Y=AMHDATE D DD^%DT S X=Y_"@"_AMHTOD S %DT="ET" D ^%DT I Y<0 W !!,"Invalid time entry, enter time of visit or 1200 for the default." G GETTOD I X="-1" W ! G GETTOD S AMHDATE=Y GETLOC ; S AMHLOC="",DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("B")=$S($$GETLOC^AMHLEIN(DUZ(2),AMHPTYPE)]"":$P(^DIC(4,$$GETLOC^AMHLEIN(DUZ(2),AMHPTYPE),0),U),1:"") D ^DIC K DIC I Y=-1,X["^" G GETTOD I Y=-1,X="" W !!,$C(7),$C(7),"REQUIRED, enter a '^' to exit.",! G GETLOC ;CMI/TUCSON/LAB - moved the S AMHLOC=+Y line to here from GETPROV-2 10/06/97 - this caused an error in group entry S AMHLOC=+Y I $E($P(^AUTTLOC(+Y,0),U,10),5,6)>50 S AMHOL="",DIR(0)="9002011,.26",DIR("A")="Enter Outside Location (e.g. Central High School)" K DA D ^DIR K DIR G:$D(DUOUT) GETLOC S AMHOL=Y ; GETPROV ;get providers K AMHPROV S AMHC=0 GETPROV1 ; K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="9002011.02,.01O",DIR("A")="Enter "_$S(AMHC=0:"PRIMARY",1:"SECONDARY")_" PROVIDER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 I $D(DUOUT) G GETLOC I $D(DIRUT),AMHC=0 G GETLOC I Y="",AMHC=0 G GETLOC I Y="",AMHC>0 G GETCOMM S AMHC=AMHC+1,AMHPROV(AMHC)=+Y,$P(AMHPROV(AMHC),U,2)=$S(AMHC=1:"P",1:"S") G GETPROV1 GETCOMM ; S AMHCOMM="",DIC(0)="AEMQ",DIC("A")="Enter COMMUNITY: ",DIC="^AUTTCOM(",DIC("B")=$$GETCOMM^AMHLEIN(DUZ(2),"M") D ^DIC K DIC,DA I Y=-1 G GETPROV S AMHCOMM=+Y GETACT ; S AMHACT="",DIR(0)="9002011,.06",DIR("A")="Enter ACTIVITY" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 I $D(DIRUT) G GETCOMM S AMHACT=Y GETCONT ; S AMHCONT="",DIR(0)="9002011,.07",DIR("A")="Enter TYPE OF CONTACT" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 I $D(DIRUT) G GETACT S AMHCONT=Y,AMHCONT(0)=Y(0) GETPOVS ; K AMHPOV S AMHC=0 GETPOVS1 ; K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="9002011.01,.01O",DIR("A")="Enter PROBLEM (POV)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 I $D(DIRUT),AMHC=0 G GETCONT I Y="",AMHC=0 G GETCONT I Y="",AMHC>0 G GETTIME S AMHPOVP=+Y GETNARR ; S AMHNARR="" S DIR(0)="FO^3:30",DIR("A")="Provider Narrative" K DA D ^DIR K DIR I $D(DUOUT) G GETPOVS S X=Y I Y="" S X=$P(^AMHPROB(AMHPOVP,0),U,2) W " ",X S DIC(0)="L",DLAYGO=9999999.27,APCDOVRR=1,DIC="^AUTNPOV(" D ^DIC K DIC I Y=-1 W !,$C(7),$C(7),"Invalid Narrative" G GETNARR S AMHNARR=+Y S AMHC=AMHC+1,AMHPOV(AMHC)=AMHPOVP_U_AMHNARR G GETPOVS1 GETTIME ; S AMHTIME="",DIR(0)="9002011,.12",DIR("A")="Enter TOTAL ACTIVITY TIME" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 I $D(DIRUT) G GETPOVS S AMHTIME=Y GETNUM ; S AMHNUM="",DIR(0)="9002011,.09",DIR("A")="Enter TOTAL NUMBER OF PATIENTS ON FORM" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 I $D(DIRUT) G GETTIME S AMHNUM=Y DISP ; W !!,"I am going to ask you to enter ",AMHNUM," patient names. I will then create a",!,"record in the MHSS file for each patient. The record will contain the",!,"following information: ",! W !,"Date of Encounter: " S Y=AMHDATE D DD^%DT W Y W ?40,"Program: ",AMHPROG(0) W !,"Loc. of Enc.: ",$E($P(^DIC(4,AMHLOC,0),U),1,25),?40,"Community: ",$E($P(^AUTTCOM(AMHCOMM,0),U),1,25) W !,"Providers: " S X=0 F S X=$O(AMHPROV(X)) Q:X'=+X W:X>1 ! W ?12,$P(^VA(200,$P(AMHPROV(X),U),0),U) W !,"Activity: ",$E($P(^AMHTACT(+AMHACT,0),U,2),1,25),?40,"Type of Contact: ",$P(AMHCONT(0),U) W !,"PROBLEM (POV): " S X=0 F S X=$O(AMHPOV(X)) Q:X'=+X W:X>1 ! W ?12,$P(^AMHPROB($P(AMHPOV(X),U),0),U)," ",$E($P(^AUTNPOV($P(AMHPOV(X),U,2),0),U),1,50) W !,"# Patients: ",AMHNUM,?15,"Total Time: ",AMHTIME,! K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 G:$D(DIRUT) XIT G:'Y XIT D ^AMHLEGP1 ENDMSG ; ;print forms? I $O(AMHLEGP("RECS ADDED",0)) D PRINT D XIT Q PRINT ; W !! S DIR(0)="Y",DIR("A")="Do you wish to PRINT an encounter form for each patient's chart",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 Q:$D(DIRUT) Q:'Y NUM ; S DIR(0)="N^1:4:0",DIR("A")="How many copies of each form do you need",DIR("B")="1" D ^DIR K DIR S:$D(DUOUT) DIRUT=1 Q:$D(DIRUT) S AMHNUM=Y S XBRP="PRINT^AMHLEGPP",XBRC="COMP^AMHLEGPP",XBRX="XIT^AMHLEGPP",XBNS="AMH" D ^XBDBQUE ;loop through all patients, records and print forms Q INFORM ; D INFORM^AMHLEGP1 Q XIT ; D XIT^AMHLEGP1 Q AMHLEL AMHLEL ; IHS/TUCSON/LAB - GETLAYS DAILY ACTIVITY RECORDS ; [ 10/06/97 10:51 AM ] ;;2.0;IHS MENTAL HLTH/SOC SERV;**1**;JUN 24, 1997 ; ;CMI/TUCSON/LAB - 10/01/97 - patch 1 - reformatted display to put back in activity time in minutes ;Display all records for the provider, program, on this date. ; ;caller must pass AMHDATE - date of encounter ; AMHDATE - date in fileman format, no time or sec ;passed back to caller: AMHRCNT - number of records found ; ^TMP("AMHVRECS",$J,n,ien)="" n is consecutive ; number ; Q EN ;EP Q:'$G(AMHRS) D REC S AMHVREC=AMHX D EOJ Q GATHER ;EP - called from AMHUAR K AMHQUIT,^TMP("AMHVRECS",$J) S AMHRCNT=0 S AMHSD=$P(AMHDATE,".")-1,(AMHODAT,AMHSD)=AMHSD_".9999",AMHSD=$O(^AMHREC("B",AMHSD)) I $P(AMHSD,".")>AMHDATE!(AMHSD="") S Y=AMHDATE D DD^%DT S ^TMP("AMHVRECS",$J,1,0)="No records currently on file for "_Y S AMHRCNT=1 D EOJ Q D GETRECS EOJ K AMHQUIT,AMHPG,AMHREC,AMHV,AMHP,Y,AMHPREC,AMHHRN,X,Y,Z,%,AMHX,AMHSD,AMHODAT,AMHX,I,L,V,AMHRS Q GETRECS ; S (AMHRCNT,AMHV)=0 F S AMHODAT=$O(^AMHREC("B",AMHODAT)) Q:AMHODAT=""!($P(AMHODAT,".")>$P(AMHDATE,"."))!($D(AMHQUIT)) D .S AMHV=0 F S AMHV=$O(^AMHREC("B",AMHODAT,AMHV)) Q:AMHV'=+AMHV!($D(AMHQUIT)) D ..S AMHRCNT=AMHRCNT+1,AMHRS=AMHRCNT,^TMP("AMHVRECS",$J,"IDX",AMHRCNT,AMHRCNT)=AMHV,AMHREC=^AMHREC(AMHV,0) D REC S ^TMP("AMHVRECS",$J,AMHRCNT,0)=AMHX ..Q .Q D EOJ Q ; REC ; S AMHX=$J(AMHRS,3)_" " S X=$$PPINI^AMHUTIL(AMHV),X=$$LBLK(X,3) S AMHX=AMHX_X_" "_$S($P(AMHREC,U,8):$E($P(^DPT($P(AMHREC,U,8),0),U),1,17),1:" --") ;CMI/TUCSON/LAB - 10/01/97 reformatted name length patch 1 S AMHX=$$RBLK(AMHX,26) ;CMI/TUCSON/LAB I $P(AMHREC,U,8)]"" D .I $P(AMHREC,U,4),$D(^AUPNPAT($P(AMHREC,U,8),41,$P(AMHREC,U,4))) S AMHHRN=$P(^AUTTLOC($P(AMHREC,U,4),0),U,7)_$P(^AUPNPAT($P(AMHREC,U,8),41,$P(AMHREC,U,4),0),U,2) Q .I $D(^AUPNPAT($P(AMHREC,U,8),41,DUZ(2))) S AMHHRN=$P(^AUTTLOC(DUZ(2),0),U,7)_$P(^AUPNPAT($P(AMHREC,U,8),41,DUZ(2),0),U,2) Q .S AMHHRN="<*****>" E S AMHHRN="-----" S AMHHRN=$$RBLK(AMHHRN,11) ;CMI/TUCSON/LAB S AMHX=AMHX_AMHHRN S AMHX=$$RBLK(AMHX,35) ;CMI/TUCSON/LAB S AMHX=AMHX_$S($P(AMHREC,U,4)]"":$E($P(^DIC(4,$P(AMHREC,U,4),0),U),1,6),1:"???") ;CMI/TUCSON/LAB - 10/06/97 - patch 1 reformatted loc S AMHX=$$RBLK(AMHX,44) ;CMI/TUCSON/LAB ;CMI/TUCSON/LAB - 10/06/97 - patch 1 added line below to put in minutes S AMHX=AMHX_$P(^AMHREC(AMHV,0),U,12),AMHX=$$RBLK(AMHX,48) S AMHX=AMHX_$$VAL^XBDIQ1(9002011,AMHV,.06) S AMHX=$$RBLK(AMHX,52) ;CMI/TUCSON/LAB S AMHP=$O(^AMHRPRO("AD",AMHV,0)) I AMHP="" S X=" ",X=$$RBLK(X,29),AMHX=AMHX_X Q D GETPROB Q GETPROB ; S AMHP=$O(^AMHRPRO("AD",AMHV,0)),AMHPREC=^AMHRPRO(AMHP,0) S X=$P(^AMHPROB($P(AMHPREC,U),0),U),X=$$LBLK(X,6)_" " S X=X_$S($P(AMHPREC,U,4)]"":$P(^AUTNPOV($P(AMHPREC,U,4),0),U),1:"") S AMHX=AMHX_X Q GETHRN ; S AMHHRN="" I $P(AMHREC,U,4)]"" D .I $D(^AUPNPAT($P(AMHREC,U,4),41,$P(AMHREC,U,4))) S AMHHRN=$P(^AUTTLOC($P(AMHREC,U,4),0),U,7)_$P(^AUPNPAT($P(AMHREC,U,4),41,$P(AMHREC,U,4),0),U,2) Q .I $D(^AUPNPAT($P(AMHREC,U,4),41,DUZ(2))) S AMHHRN=$P(^AUTTLOC(DUZ(2),0),U,7)_$P(^AUPNPAT($P(AMHREC,U,4),41,DUZ(2),0),U,2) Q .S AMHHRN="" E S AMHHRN=" -- " Q RBLK(V,L) ;left blank fill NEW %,I S %=$L(V),Z=L-% F I=1:1:Z S V=V_" " Q V LBLK(V,L) ;left blank fill NEW %,I S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V Q V AMHLESM AMHLESM ; IHS/TUCSON/LAB - calls from within screenman ; [ 10/27/97 9:59 AM ] ;;2.0;IHS MENTAL HLTH/SOC SERV;**1**;JUN 24, 1997 ; ;CMI/TUCSON/LAB - 10/06/97 - PATCH 1 ADDED CODE TO PROPERLY DISPLAY AXIS IV&V ON PREVIOUS POV DISPLAYS (SUB ROUTINES HPOV AND HPOV1) ;*** Lori Butcher - IHS Information Systems Division Tucson, AZ *** EN1(AMHPAT) ;EP - called from protocol Q:'$G(AMHPAT) D HMED1 NEW C S C="Medication List for "_$P(^DPT(AMHPAT,0),U) D ARRAY^XBLM("^TMP(""AMHDSPMEDS"",$J,",C) K ^TMP("AMHSMEDS",$J),^TMP("AMHDSPMEDS",$J) Q HMED ;EP - display last ;display last 2 years worth of meds from V Med ;display last 2 years worth of meds from mhss record I '$G(AMHPAT) S AMHMSG(1)="Unknown Patient" D HLP^DDSUTL(.AMHMSG) K AMHMSG Q D HMED1 NEW C S C="Medication List for "_$P(^DPT(AMHPAT,0),U) D ARRAY^XBLM("^TMP(""AMHDSPMEDS"",$J,",C) K ^TMP("AMHDSPMEDS",$J) REFRESH ; S X=0 X ^%ZOSF("RM") W $P(DDGLVID,DDGLDEL,8) D REFRESH^DDSUTL Q HMED1 ;EP S (%,%1)="" D GETMEDS^AMHLEMD(AMHPAT,%,%1,"L") D GETMHMD D SETARRAY Q SETARRAY ; K ^TMP("AMHDSPMEDS",$J) S ^TMP("AMHDSPMEDS",$J,0)=0 ;S X="Displayed is the MEDICATIONS PRESCRIBED data field from the MHSS data file" D S(X) ;S X="for the past 2 years of visits." D S(X) ;S X="Also, the last of each type of medication from the PCC Database is displayed." D S(X) S X=" " D S(X) S X=" " D S(X) S X="*** Medications Prescribed entries in MHSS Database for last 2 years ***" D S(X) S I=0 F S I=$O(^TMP("AMHSMEDS",$J,"M",I)) Q:I'=+I S X=^TMP("AMHSMEDS",$J,"M",I) D S(X) S X=" " D S(X) S X="The last of each type of medication from the PCC Database is displayed below." D S(X) S I=0 F S I=$O(^TMP("AMHSMEDS",$J,"A",I)) Q:I'=+I S X=^TMP("AMHSMEDS",$J,"A",I) D S(X) Q GETMHMD ;set array ^TMP("AMHSMEDS",$J,"M" OF MEDS IN MH FILE K ^TMP("AMHSMEDS",$J,"M") NEW AMHLAST,AMHC S AMHLAST=9999999-(DT-20000),AMHC=0 NEW I S I=0 F S I=$O(^AMHREC("AE",AMHPAT,I)) Q:I=""!(I>AMHLAST) D .S X=0 F S X=$O(^AMHREC("AE",AMHPAT,I,X)) Q:X="" D ..Q:'$D(^AMHREC(X,41,0)) ..S AMHC=AMHC+1,^TMP("AMHSMEDS",$J,"M",AMHC)=$$FMTE^XLFDT((9999999-$P(I,".")),"2E") ..S C=0 F S C=$O(^AMHREC(X,41,C)) Q:C'=+C S AMHC=AMHC+1,^TMP("AMHSMEDS",$J,"M",AMHC)=^AMHREC(X,41,C,0) ..Q Q S(Y,F,C,T) ; I '$G(F) S F=0 I '$G(T) S T=0 ;blank lines F F=1:1:(T-1) S X=" "_X F %=1:1:T S X=" "_Y D S1 Q S1 ; S %=$P(^TMP("AMHDSPMEDS",$J,0),U)+1,$P(^TMP("AMHDSPMEDS",$J,0),U)=% S ^TMP("AMHDSPMEDS",$J,%,0)=X Q HPOV ;EP display last visit's povs NEW AMHC1,AMHA,AMHMSG,%,AMHA,AMHB,AMHT,AMHV,AMHC,AMHCC,X,S,Y,Z ;CMI/TUCSON/LAB - added X,S,Y,Z patch 1 10/06/97 Q:'$G(AMHR) Q:'$G(AMHPAT) S AMHC=$$VAL^XBDIQ1(9002013,DUZ(2),.25) S:'AMHC AMHC=1 S AMHC1=1,AMHMSG(AMHC1)="Patient's Diagnoses from last "_AMHC_" visit"_$S(AMHC=1:"",1:"s")_":" S (AMHA,AMHV,AMHCC)=0 F S AMHA=$O(^AMHREC("AE",AMHPAT,AMHA)) Q:AMHA'=+AMHA!(AMHV) D .S AMHT=0 F S AMHT=$O(^AMHREC("AE",AMHPAT,AMHA,AMHT)) Q:AMHT'=+AMHT!(AMHV) I AMHT'=AMHR,$D(^AMHRPRO("AD",AMHT)) D ..I $P($G(^AMHSITE(DUZ(2),0)),U,26) Q:$$NOSHOW(AMHT) ..S AMHB=0 F S AMHB=$O(^AMHRPRO("AD",AMHT,AMHB)) Q:AMHB'=+AMHB D ...S AMHC1=AMHC1+1,AMHMSG(AMHC1)=$$FMTE^XLFDT($P($P(^AMHREC($P(^AMHRPRO(AMHB,0),U,3),0),U),"."),"2E")_" "_$$VAL^XBDIQ1(9002011.01,AMHB,.01)_" "_$E($$VAL^XBDIQ1(9002011.01,AMHB,.04),1,52) ...S AMHC1=AMHC1+1,AMHMSG(AMHC1)="Provider: "_$$PPINI^AMHUTIL(AMHT)_" " ;CMI/TUCSON/LAB - removed 1 space patch 1 10/06/97 ...;I $P(^AMHREC(AMHT,0),U,14)]""!($P(^AMHREC(AMHT,0),U,13)]"") D ...;S AMHMSG(AMHC1)=AMHMSG(AMHC1)_"AXIS IV: "_$$VAL^XBDIQ1(9002011,AMHT,.13)_" "_$S($P(^AMHREC(AMHT,0),U,13)]"":$P(^AMHTAXIV($P(^AMHREC(AMHT,0),U,13),0),U,2),1:"")_" AXIS V: "_$$VAL^XBDIQ1(9002011,AMHT,.14) ...;CMI/TUCSON/LAB - 10/06/97 - replaced the 2 lines above with 4 lines below to properly display AXIS IV data patch 1 ...S X=0,S="" F S X=$O(^AMHREC(AMHT,61,X)) Q:X'=+X S Y=$P(^AMHREC(AMHT,61,X,0),U),S=S_" "_$P(^AMHTAXIV(Y,0),U)_"-"_$E($P(^AMHTAXIV(Y,0),U,2),1,8) ...S Z="AXIS IV:"_S ...I $P(^AMHREC(AMHT,0),U,14)]"" S Z=Z_" AXIS V: "_$P(^AMHREC(AMHT,0),U,14) ...S AMHMSG(AMHC1)=AMHMSG(AMHC1)_" "_Z ...S AMHCC=AMHCC+1 I AMHCC=AMHC S AMHV=AMHT Q I 'AMHCC S AMHMSG(1)="No prior diagnoses on file for this patient." G HLP HLP D HLP^DDSUTL(.AMHMSG) K AMHCC Q HPOV1 ;EP called from input template NEW C,AMHMSG,%,A,B,R Q:'$G(AMHR) Q:'$G(AMHPAT) S (A,%)=0 F S A=$O(^AMHREC("AE",AMHPAT,A)) Q:A'=+A!(%) D .S R=0 F S R=$O(^AMHREC("AE",AMHPAT,A,R)) Q:R'=+R!(%) I R'=AMHR,$D(^AMHRPRO("AD",R)) S %=R I '% W !!,"No prior diagnoses on file for this patient." S C=1 W !!,"Patient's Diagnoses from last visit:" S B=0 F S B=$O(^AMHRPRO("AD",%,B)) Q:B'=+B D .;CMI/TUCSON/LAB - 10/06/97 - patch 1 added display of axis iv&v by adding next 4 lines .S C=C+1 W !,$$FMTE^XLFDT($P($P(^AMHREC($P(^AMHRPRO(B,0),U,3),0),U),"."),"2E")_" "_$$VAL^XBDIQ1(9002011.01,B,.01)_" "_$E($$VAL^XBDIQ1(9002011.01,B,.04),1,52) .S X=0,S="" F S X=$O(^AMHREC(%,61,X)) Q:X'=+X S Y=$P(^AMHREC(%,61,X,0),U),S=S_" "_$P(^AMHTAXIV(Y,0),U)_"-"_$E($P(^AMHTAXIV(Y,0),U,2),1,8) .S Z=" AXIS IV:"_S .I $P(^AMHREC(%,0),U,14)]"" S Z=Z_" AXIS V: "_$P(^AMHREC(%,0),U,14) .W !,"Provider: ",$$PPINI^AMHUTIL(%),$G(Z) .Q W ! Q NOSHOW(V) ;return 0 if no noshows, 1 if noshow NEW %,X Q:'$G(V) S (%,X)=0 F S X=$O(^AMHRPRO("AD",V,X)) Q:X'=+X I $$VAL^XBDIQ1(9002011.01,X,.01)=8 S %=1 Q % AMHRBV2 AMHRBV2 ; IHS/TUCSON/LAB - gather billable visits ; [ 09/22/97 10:55 AM ] ;;2.0;IHS MENTAL HLTH/SOC SERV;**1**;JUN 24, 1997 ; ;CMI/TUCSON/LAB - 09/22/97 - modified activity data to not bomb if null ;SEARCH VISIT FILE FOR DATE RANGE AND GENERATE CLINIC COUNTS ; S AMHJOB=$J,AMHBT=$H K ^XTMP("AMHRBV",AMHJOB,AMHBT) D XTMP^AMHUTIL("AMHRBV","MHSS - BILLABLE VISITS") S AMHS=AMHSD-.000001 D @AMHPROC S AMHET=$H Q 1 F X="03","04","30","31" S Y=$O(^AUTTBEN("C",X,"")) S AMHCOAR(Y)="" S AMHCOPN(Y)=$P(^AUTTBEN(Y,0),U) D V ; Q V ; F I=0:0 S AMHS=$O(^AMHREC("B",AMHS)) Q:AMHS=""!($P(AMHS,".")>AMHED) D V1 Q V1 ; S AMHVDFN="" F J=0:0 S AMHVDFN=$O(^AMHREC("B",AMHS,AMHVDFN)) Q:AMHVDFN="" S AMHVN0=^AMHREC(AMHVDFN,0) S DFN=$P(AMHVN0,U,8) I DFN]"" D @(AMHPROC_"2") Q 12 ; Q:'$D(^AUPNPAT(DFN,41,AMHSU,0)) Q:'$D(^AUPNPAT(DFN,11)) S AMHCOP=$P(^AUPNPAT(DFN,11),U,11) Q:AMHCOP="" Q:'$D(AMHCOAR(AMHCOP)) VC ; S AMHACT=$P(AMHVN0,U,6) Q:'AMHACT Q:'$P(^AMHTACT(AMHACT,0),U,6) ;do not use non patient activities CMI/TUCSON/LAB - added Q:'AMHACT to not bomb if activity null S AMHVISIT=$P(AMHVN0,U,16) Q:'$D(^AMHRPROV("AD",AMHVDFN)) Q:'$D(^AMHRPRO("AD",AMHVDFN)) Q:$P(AMHVN0,U,4)'=AMHSU S AMHPN=$P(^DPT(DFN,0),U) S ^XTMP("AMHRBV",AMHJOB,AMHBT,AMHPN,DFN,AMHVDFN)="" Q 2 ; S AMHVAL=$S(AMHPROC=2:"A",1:"B") S AMHPROC=2 D V Q 22 ; Q:'$D(^DPT(DFN,0)) Q:'$D(^AUPNMCR(DFN,11)) Q:'$D(^AUPNPAT(DFN,41,AMHSU,0)) I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(AMHS,".") Q K AMHGOT S AMHMDFN=0 F S AMHMDFN=$O(^AUPNMCR(DFN,11,AMHMDFN)) Q:AMHMDFN'=+AMHMDFN!($D(AMHGOT)) D 23 Q:'$D(AMHGOT) S AMHPN=$P(^DPT(DFN,0),U) D VC Q ; 23 ; Q:AMHVAL'[$P(^AUPNMCR(DFN,11,AMHMDFN,0),U,3) Q:$P(^AUPNMCR(DFN,11,AMHMDFN,0),U)>$P(AMHS,".") I $P(^AUPNMCR(DFN,11,AMHMDFN,0),U,2)]"",$P(^(0),U,2)<$P(AMHS,".") Q S AMHGOT="" Q ; 3 ; D 2 Q ; 5 ; D V Q 52 ; Q:'$D(^AUPNPRVT(DFN,11)) Q:'$D(^AUPNPAT(DFN,41,AMHSU)) I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(AMHS,".") Q S AMHPN=$P(^DPT(DFN,0),U) K AMHGOT S AMHMDFN=0 F S AMHMDFN=$O(^AUPNPRVT(DFN,11,AMHMDFN)) Q:AMHMDFN'=+AMHMDFN D 53 Q:'$D(AMHGOT) D VC Q 53 ; Q:$P(^AUPNPRVT(DFN,11,AMHMDFN,0),U)="" S AMHNAME=$P(^AUPNPRVT(DFN,11,AMHMDFN,0),U) Q:AMHNAME="" S AMHNAME=$P(^AUTNINS(AMHNAME,0),U) I AMHNAME["AHCCCS" Q Q:$P(^AUPNPRVT(DFN,11,AMHMDFN,0),U,6)="" Q:$P(^AUPNPRVT(DFN,11,AMHMDFN,0),U,6)>$P(AMHS,".") I $P(^AUPNPRVT(DFN,11,AMHMDFN,0),U,7)]"",$P(^(0),U,7)<$P(AMHS,".") Q S AMHGOT="" Q ; 4 ; D V Q 42 ; Q:'$D(^AUPNPAT(DFN,41,AMHSU)) I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(AMHS,".") Q S AMHPN=$P(^DPT(DFN,0),U) K AMHGOT S AMHMDFN=0 S AMHMDFN=$O(^AUPNMCD("B",DFN,AMHMDFN)) Q:AMHMDFN'=+AMHMDFN!($D(AMHGOT)) D 43 Q:'$D(AMHGOT) D VC Q 43 ; Q:'$D(^AUPNMCD(AMHMDFN,11)) K AMHGOT S AMHNDFN=0 F S AMHNDFN=$O(^AUPNMCD(AMHMDFN,11,AMHNDFN)) Q:AMHNDFN'=+AMHNDFN!($D(AMHGOT)) S AMHREC=^AUPNMCD(AMHMDFN,11,AMHNDFN,0) D 44 Q 44 ; Q:AMHNDFN>$P(AMHS,".") I $P(AMHREC,U,2)]"",$P(AMHREC,U,2)<$P(AMHS,".") Q S AMHGOT="" Q ; 6 ;NON INDIANS D V Q 62 ; Q:'$D(^AUPNPAT(DFN,41,AMHSU)) I $D(^DPT(DFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)<$P(AMHS,".") Q Q:'$D(^AUPNPAT(DFN,11)) Q:$P(^AUPNPAT(DFN,11),U,8)="" S AMHTRI=$P(^AUPNPAT(DFN,11),U,8) Q:'$D(^AUTTTRI(AMHTRI)) S AMHTRIC=$P(^AUTTTRI(AMHTRI,0),U,2) Q:(+AMHTRIC&(AMHTRIC<969)) D VC Q