AMHLEGP ; IHS/CMI/LAB - BH GROUP FORM DATA ENTRY ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
D ^AMHLEIN
D INFORM
GETDATE ; GET DATE OF ENCOUNTER
S AMHGROUP=1 ; so I know I am in group entry
S AMHDATE="",DIR(0)="D^:"_DT_":EPT",DIR("A")="Enter ENCOUNTER DATE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
S %DT="ET" D ^%DT G:Y<0 GETDATE
I Y>DT W " <Future dates not allowed>",$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;C:Chemical Dependency;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: " D ^DIC K DIC
I X="" W !!,"Clinic is required. Type '^' to exit or enter a clinic code." G GETCLN
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 CODE" 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")=$S(AMHC=0:"Enter PROBLEM (POV)",1:"Enter another PROBLEM (POV) or press enter if none") D ^DIR K DIR
K DIR
I $D(DUOUT) G GETCONT
I $D(DIRUT),AMHC=0 G GETCONT
I Y="",AMHC=0 G GETCONT
I Y="",AMHC>0 G GETCPTS
I $D(DIRUT),AMHC>0 G GETCPTS
S AMHPOVP=+Y
GETNARR ;
S AMHNARR=""
S DIR(0)="FO^3:79",DIR("A")="Provider Narrative" K DA D ^DIR K DIR
I $D(DUOUT) G GETCPTS
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,DLAYGO,DIADD,DD,DO 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
GETCPTS ;
K AMHCPT S AMHC=0
GETCPTS1 ;
K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="9002011.04,.01O",DIR("A")="Enter CPT CODE (or enter if none)" D ^DIR K DIR
K DIR
I Y="" G GETEDUC
I $D(DUOUT) G GETPOVS
I $D(DIRUT),AMHC=0 G GETPOVS
I Y="" G GETTIME
I $D(DIRUT),AMHC>0 G GETEDUC
S AMHCPTP=+Y
S AMHC=AMHC+1,AMHCPT(AMHC)=AMHCPTP
G GETCPTS1
GETEDUC ;
K AMHEDUC S AMHC=0
GETEDUC1 ;
K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="9002011.05,.01O",DIR("A")="Enter EDUCATION TOPIC (or enter if none)" D ^DIR K DIR
K DIR
I Y="" G GETTIME
I $D(DIRUT),AMHC=0 G GETCPTS
I Y="" G GETTIME
I $D(DIRUT),AMHC>0 G GETTIME
S AMHCPTP=+Y
S AMHC=AMHC+1,AMHEDUC(AMHC)=AMHCPTP
;get provider
K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="9002011.05,.04",DIR("A")=" Enter Education PROVIDER" D ^DIR K DIR
I +Y S $P(AMHEDUC(AMHC),U,2)="`"_+Y
K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="9002011.05,.06",DIR("A")=" Enter Length of Education (minutes)" D ^DIR K DIR
I $D(DIRUT) S Y=""
S $P(AMHEDUC(AMHC),U,3)=Y
K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="9002011.05,.07",DIR("A")=" Enter CPT code for Education" D ^DIR K DIR
I +Y S $P(AMHEDUC(AMHC),U,4)=Y
K DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR(0)="9002011.05,1101",DIR("A")=" Enter COMMENT about the education" D ^DIR K DIR
I $D(DIRUT) S Y=""
S $P(AMHEDUC(AMHC),U,5)=Y
G GETEDUC1
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 BH 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")="Y" 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
K AMHEFT,AMHEFTH
W !! S DIR(0)="S^F:Full Encounter Form;S:Suppressed Encounter Form;B:Both a Suppressed & Full;T:2 copies of the Suppressed;E:2 copies of the Full"
S DIR("B")=$S($P(^AMHSITE(DUZ(2),0),U,23)]"":$P(^AMHSITE(DUZ(2),0),U,23),1:"B") K DA D ^DIR K DIR
Q:$D(DIRUT)
S (AMHEFT,AMHEFTH)=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
AMHLEGP ; IHS/CMI/LAB - BH GROUP FORM DATA ENTRY ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 DO ^AMHLEIN
+4 DO INFORM
GETDATE ; GET DATE OF ENCOUNTER
+1 ; so I know I am in group entry
SET AMHGROUP=1
+2 SET AMHDATE=""
SET DIR(0)="D^:"_DT_":EPT"
SET DIR("A")="Enter ENCOUNTER DATE"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO XIT
+4 SET %DT="ET"
DO ^%DT
IF Y<0
GOTO GETDATE
+5 IF Y>DT
WRITE " <Future dates not allowed>",$CHAR(7),$CHAR(7)
KILL X
GOTO GETDATE
+6 SET AMHDATE=Y
GETPROG ;
+1 SET AMHPROG=""
+2 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="SB^M:Mental Health;S:Social Services;C:Chemical Dependency;O:Other"
SET DIR("A")="Enter PROGRAM"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO GETDATE
+4 SET AMHPROG=Y
SET AMHPROG(0)=Y(0)
SET AMHPTYPE=Y
GETCLN ;
+1 SET AMHCLN=""
SET DIC="^DIC(40.7,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter CLINIC: "
DO ^DIC
KILL DIC
+2 IF X=""
WRITE !!,"Clinic is required. Type '^' to exit or enter a clinic code."
GOTO GETCLN
+3 IF Y<0
GOTO GETPROG
+4 SET AMHCLN=+Y
GETTOD ;
+1 SET AMHDATE=$PIECE(AMHDATE,".")
+2 SET AMHTOD="12:00"
+3 WRITE !,"ARRIVAL Time: ",$SELECT(AMHTOD]"":AMHTOD_"// ",1:"")
READ X:$SELECT($DATA(DTIME):DTIME,1:300)
IF '$TEST
SET X="^"
IF X=""
SET X=AMHTOD
+4 IF X="^"
GOTO GETCLN
+5 IF X=""
SET AMHTOD="12:00"
GOTO EDTIME
+6 IF X["?"
WRITE !,"Enter time of arrival, or 'D' for default."
GOTO GETTOD
+7 IF X="D"
SET X="12:00"
WRITE " ",X
+8 SET AMHTOD=X
EDTIME SET Y=AMHDATE
DO DD^%DT
SET X=Y_"@"_AMHTOD
+1 SET %DT="ET"
DO ^%DT
IF Y<0
WRITE !!,"Invalid time entry, enter time of visit or 1200 for the default."
GOTO GETTOD
+2 IF X="-1"
WRITE !
GOTO GETTOD
+3 SET AMHDATE=Y
GETLOC ;
+1 SET AMHLOC=""
SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
SET DIC("B")=$SELECT($$GETLOC^AMHLEIN(DUZ(2),AMHPTYPE)]"":$PIECE(^DIC(4,$$GETLOC^AMHLEIN(DUZ(2),AMHPTYPE),0),U),1:"")
DO ^DIC
KILL DIC
+2 IF Y=-1
IF X["^"
GOTO GETTOD
+3 IF Y=-1
IF X=""
WRITE !!,$CHAR(7),$CHAR(7),"REQUIRED, enter a '^' to exit.",!
GOTO GETLOC
+4 ;CMI/TUCSON/LAB - moved the S AMHLOC=+Y line to here from GETPROV-2 10/06/97 - this caused an error in group entry
+5 SET AMHLOC=+Y
+6 IF $EXTRACT($PIECE(^AUTTLOC(+Y,0),U,10),5,6)>50
SET AMHOL=""
SET DIR(0)="9002011,.26"
SET DIR("A")="Enter Outside Location (e.g. Central High School)"
KILL DA
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
GOTO GETLOC
SET AMHOL=Y
+7 ;
GETPROV ;get providers
+1 KILL AMHPROV
SET AMHC=0
GETPROV1 ;
+1 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="9002011.02,.01O"
SET DIR("A")="Enter "_$SELECT(AMHC=0:"PRIMARY",1:"SECONDARY")_" PROVIDER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DUOUT)
GOTO GETLOC
+3 IF $DATA(DIRUT)
IF AMHC=0
GOTO GETLOC
+4 IF Y=""
IF AMHC=0
GOTO GETLOC
+5 IF Y=""
IF AMHC>0
GOTO GETCOMM
+6 SET AMHC=AMHC+1
SET AMHPROV(AMHC)=+Y
SET $PIECE(AMHPROV(AMHC),U,2)=$SELECT(AMHC=1:"P",1:"S")
+7 GOTO GETPROV1
GETCOMM ;
+1 SET AMHCOMM=""
SET DIC(0)="AEMQ"
SET DIC("A")="Enter COMMUNITY: "
SET DIC="^AUTTCOM("
SET DIC("B")=$$GETCOMM^AMHLEIN(DUZ(2),"M")
DO ^DIC
KILL DIC,DA
+2 IF Y=-1
GOTO GETPROV
+3 SET AMHCOMM=+Y
GETACT ;
+1 SET AMHACT=""
SET DIR(0)="9002011,.06"
SET DIR("A")="Enter ACTIVITY CODE"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETCOMM
+3 SET AMHACT=Y
GETCONT ;
+1 SET AMHCONT=""
SET DIR(0)="9002011,.07"
SET DIR("A")="Enter TYPE OF CONTACT"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETACT
+3 SET AMHCONT=Y
SET AMHCONT(0)=Y(0)
GETPOVS ;
+1 KILL AMHPOV
SET AMHC=0
GETPOVS1 ;
+1 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="9002011.01,.01O"
SET DIR("A")=$SELECT(AMHC=0:"Enter PROBLEM (POV)",1:"Enter another PROBLEM (POV) or press enter if none")
DO ^DIR
KILL DIR
+2 KILL DIR
+3 IF $DATA(DUOUT)
GOTO GETCONT
+4 IF $DATA(DIRUT)
IF AMHC=0
GOTO GETCONT
+5 IF Y=""
IF AMHC=0
GOTO GETCONT
+6 IF Y=""
IF AMHC>0
GOTO GETCPTS
+7 IF $DATA(DIRUT)
IF AMHC>0
GOTO GETCPTS
+8 SET AMHPOVP=+Y
GETNARR ;
+1 SET AMHNARR=""
+2 SET DIR(0)="FO^3:79"
SET DIR("A")="Provider Narrative"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DUOUT)
GOTO GETCPTS
+4 SET X=Y
IF Y=""
SET X=$PIECE(^AMHPROB(AMHPOVP,0),U,2)
WRITE " ",X
+5 SET DIC(0)="L"
SET DLAYGO=9999999.27
SET APCDOVRR=1
SET DIC="^AUTNPOV("
DO ^DIC
KILL DIC,DLAYGO,DIADD,DD,DO
IF Y=-1
WRITE !,$CHAR(7),$CHAR(7),"Invalid Narrative"
GOTO GETNARR
+6 SET AMHNARR=+Y
+7 SET AMHC=AMHC+1
SET AMHPOV(AMHC)=AMHPOVP_U_AMHNARR
+8 GOTO GETPOVS1
GETCPTS ;
+1 KILL AMHCPT
SET AMHC=0
GETCPTS1 ;
+1 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="9002011.04,.01O"
SET DIR("A")="Enter CPT CODE (or enter if none)"
DO ^DIR
KILL DIR
+2 KILL DIR
+3 IF Y=""
GOTO GETEDUC
+4 IF $DATA(DUOUT)
GOTO GETPOVS
+5 IF $DATA(DIRUT)
IF AMHC=0
GOTO GETPOVS
+6 IF Y=""
GOTO GETTIME
+7 IF $DATA(DIRUT)
IF AMHC>0
GOTO GETEDUC
+8 SET AMHCPTP=+Y
+9 SET AMHC=AMHC+1
SET AMHCPT(AMHC)=AMHCPTP
+10 GOTO GETCPTS1
GETEDUC ;
+1 KILL AMHEDUC
SET AMHC=0
GETEDUC1 ;
+1 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="9002011.05,.01O"
SET DIR("A")="Enter EDUCATION TOPIC (or enter if none)"
DO ^DIR
KILL DIR
+2 KILL DIR
+3 IF Y=""
GOTO GETTIME
+4 IF $DATA(DIRUT)
IF AMHC=0
GOTO GETCPTS
+5 IF Y=""
GOTO GETTIME
+6 IF $DATA(DIRUT)
IF AMHC>0
GOTO GETTIME
+7 SET AMHCPTP=+Y
+8 SET AMHC=AMHC+1
SET AMHEDUC(AMHC)=AMHCPTP
+9 ;get provider
+10 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="9002011.05,.04"
SET DIR("A")=" Enter Education PROVIDER"
DO ^DIR
KILL DIR
+11 IF +Y
SET $PIECE(AMHEDUC(AMHC),U,2)="`"_+Y
+12 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="9002011.05,.06"
SET DIR("A")=" Enter Length of Education (minutes)"
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
SET Y=""
+14 SET $PIECE(AMHEDUC(AMHC),U,3)=Y
+15 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="9002011.05,.07"
SET DIR("A")=" Enter CPT code for Education"
DO ^DIR
KILL DIR
+16 IF +Y
SET $PIECE(AMHEDUC(AMHC),U,4)=Y
+17 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="9002011.05,1101"
SET DIR("A")=" Enter COMMENT about the education"
DO ^DIR
KILL DIR
+18 IF $DATA(DIRUT)
SET Y=""
+19 SET $PIECE(AMHEDUC(AMHC),U,5)=Y
+20 GOTO GETEDUC1
GETTIME ;
+1 SET AMHTIME=""
SET DIR(0)="9002011,.12"
SET DIR("A")="Enter TOTAL ACTIVITY TIME"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETPOVS
+3 SET AMHTIME=Y
GETNUM ;
+1 SET AMHNUM=""
SET DIR(0)="9002011,.09"
SET DIR("A")="Enter TOTAL NUMBER OF PATIENTS ON FORM"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO GETTIME
+3 SET AMHNUM=Y
DISP ;
+1 WRITE !!,"I am going to ask you to enter ",AMHNUM," patient names. I will then create a",!,"record in the BH file for each patient. The record will contain the",!,"following information: ",!
+2 WRITE !,"Date of Encounter: "
SET Y=AMHDATE
DO DD^%DT
WRITE Y
WRITE ?40,"Program: ",AMHPROG(0)
+3 WRITE !,"Loc. of Enc.: ",$EXTRACT($PIECE(^DIC(4,AMHLOC,0),U),1,25),?40,"Community: ",$EXTRACT($PIECE(^AUTTCOM(AMHCOMM,0),U),1,25)
+4 WRITE !,"Providers: "
SET X=0
FOR
SET X=$ORDER(AMHPROV(X))
IF X'=+X
QUIT
IF X>1
WRITE !
WRITE ?12,$PIECE(^VA(200,$PIECE(AMHPROV(X),U),0),U)
+5 WRITE !,"Activity: ",$EXTRACT($PIECE(^AMHTACT(+AMHACT,0),U,2),1,25),?40,"Type of Contact: ",$PIECE(AMHCONT(0),U)
+6 WRITE !,"PROBLEM (POV): "
SET X=0
FOR
SET X=$ORDER(AMHPOV(X))
IF X'=+X
QUIT
IF X>1
WRITE !
WRITE ?12,$PIECE(^AMHPROB($PIECE(AMHPOV(X),U),0),U)," ",$EXTRACT($PIECE(^AUTNPOV($PIECE(AMHPOV(X),U,2),0),U),1,50)
+7 WRITE !,"# Patients: ",AMHNUM,?15,"Total Time: ",AMHTIME,!
+8 KILL DIR,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y
SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+9 IF $DATA(DIRUT)
GOTO XIT
+10 IF 'Y
GOTO XIT
+11 DO ^AMHLEGP1
ENDMSG ;
+1 ;print forms?
+2 IF $ORDER(AMHLEGP("RECS ADDED",0))
DO PRINT
+3 DO XIT
+4 QUIT
PRINT ;
+1 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you wish to PRINT an encounter form for each patient's chart"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 IF 'Y
QUIT
NUM ;
+1 ;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
+2 ;Q:$D(DIRUT)
+3 ;S AMHNUM=Y
+4 KILL AMHEFT,AMHEFTH
+5 WRITE !!
SET DIR(0)="S^F:Full Encounter Form;S:Suppressed Encounter Form;B:Both a Suppressed & Full;T:2 copies of the Suppressed;E:2 copies of the Full"
+6 SET DIR("B")=$SELECT($PIECE(^AMHSITE(DUZ(2),0),U,23)]"":$PIECE(^AMHSITE(DUZ(2),0),U,23),1:"B")
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
QUIT
+8 SET (AMHEFT,AMHEFTH)=Y
+9 SET XBRP="PRINT^AMHLEGPP"
SET XBRC="COMP^AMHLEGPP"
SET XBRX="XIT^AMHLEGPP"
SET XBNS="AMH"
+10 DO ^XBDBQUE
+11 ;loop through all patients, records and print forms
+12 QUIT
INFORM ;
+1 DO INFORM^AMHLEGP1
+2 QUIT
XIT ;
+1 DO XIT^AMHLEGP1
+2 QUIT
