AMHLE ; IHS/CMI/LAB - MENTAL HLTH ROUTINE 16-AUG-1994 ;
;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28
;; ;
;CMI/TUCSON/LAB - 10/06/97 - PATCH 1 reformat header
START ; Write Header
D TERM^VALM0
I AMHDET="R" D Q:'Y
.W !!,$G(IORVON)_"The RDE option will be deactivated in the next application release. Users are"
.W !,"encouraged to begin utilizing the PDE or SDE options.",$G(IORVOFF),!
.D PAUSE^AMHLEA
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;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER",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: "_$$DOW^XLFDT(AMHDATE)_" "_$$FTIME^VALM1(AMHDATE)_$S($$ESIGREQ^AMHESIG(,AMHDATE):" * unsigned note",1:"")
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 ACT PROB NARRATIVE"
Q
;
INIT ;EP -- init variables and list array
;S VALMSG="Q - Quit ?? for more actions + next screen - prev screen"
S VALMSG=" ?? for more actions"
D GATHER^AMHLEL ;gather up all records for display
S VALMCNT=AMHRCNT
I VALMCNT>11 S VALMSG="+ for more contacts, - to back up ?? for more actions"
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 ;
;;BH Data Entry Module
;;
;;************************
;;* Update BH Visits *
;;************************
;;
Q
DISPDG ;EP
W !!,"You are processing a record for the following sensitive patient:",!
W !?5,$P(^DPT(AMHPAT,0),U,1),?40,"DOB: ",$$FMTE^XLFDT($$DOB^AUPNPAT(AMHPAT)),?65,"HRN: ",$$HRN^AUPNPAT(AMHPAT,DUZ(2))
S X=1 F S X=$O(AMHRESU(X)) Q:X'=+X W !,$$CTR^AMHLEIN(AMHRESU(X))
Q
AMHLE ; IHS/CMI/LAB - MENTAL HLTH ROUTINE 16-AUG-1994 ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**4**;JUN 18, 2010;Build 28
+2 ;; ;
+3 ;CMI/TUCSON/LAB - 10/06/97 - PATCH 1 reformat header
START ; Write Header
+1 DO TERM^VALM0
+2 IF AMHDET="R"
Begin DoDot:1
+3 WRITE !!,$GET(IORVON)_"The RDE option will be deactivated in the next application release. Users are"
+4 WRITE !,"encouraged to begin utilizing the PDE or SDE options.",$GET(IORVOFF),!
+5 DO PAUSE^AMHLEA
End DoDot:1
IF 'Y
QUIT
+6 ; -- kill all vars before starting
DO EN^AMHEKL
+7 IF $DATA(IOF)
WRITE @IOF
+8 FOR J=1:1:5
SET X=$PIECE($TEXT(TEXT+J),";;",2)
WRITE !?80-$LENGTH(X)\2,X
+9 KILL X,J
+10 WRITE !!
+11 ;Initialize vars, etc.
DO ^AMHLEIN
+12 ;loop through until user wants to quit
+13 SET AMHPTYPE=""
DO GETTYPE
IF AMHPTYPE=""
QUIT
SET AMHDATE=""
FOR
DO GETDATE
IF AMHDATE=""
QUIT
DO EN
DO FULL^VALM1
DO EXIT
+14 DO EOJ
+15 QUIT
+16 ;
EOJ ;EOJ CLEANUP
+1 DO CLEAR^VALM1
+2 DO EN^AMHEKL
+3 QUIT
GETTYPE ;EP
+1 IF $GET(AMHPATCE)
DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+2 SET AMHPTYPE=""
+3 WRITE !,"Please enter the appropriate set of defaults to be used in Data entry.",!,"This applies to default clinic, location, community and program.",!
+4 SET DIR(0)="S^M:MENTAL HEALTH DEFAULTS;S:SOCIAL SERVICES DEFAULTS;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER"
SET DIR("A")="Which set of defaults do you want to use in Data Entry"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
QUIT
+6 SET AMHPTYPE=Y
+7 QUIT
GETDATE ;EP - GET DATE OF ENCOUNTER
+1 WRITE !!
+2 SET AMHDATE=""
SET DIR(0)="DO^:"_DT_":EPTX"
SET DIR("A")="Enter ENCOUNTER DATE"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 SET AMHDATE=Y
+5 QUIT
EN ; EP -- main entry point for AMH UPDATE ACTIVITY RECORDS
+1 ;S AMHKDTIM=DTIME S:DTIME<3600 DTIME=3600
+2 SET VALMCC=1
+3 DO EN^VALM("AMH UPDATE ACTIVITY RECORDS")
+4 DO CLEAR^VALM1
+5 ;S DTIME=AMHKDTIM
+6 KILL AMHKDTIM
+7 QUIT
+8 ;
HDR ;EP -- header code
+1 SET VALMHDR(1)=AMHDASH
+2 SET VALMHDR(2)="Date of Encounter: "_$$DOW^XLFDT(AMHDATE)_" "_$$FTIME^VALM1(AMHDATE)_$SELECT($$ESIGREQ^AMHESIG(,AMHDATE):" * unsigned note",1:"")
+3 SET VALMHDR(3)=AMHDASH
+4 IF $EXTRACT($GET(^TMP("AMHVRECS",$JOB,1,0)))="N"
SET AMHRCNT=0
SET VALMHDR(4)=^TMP("AMHVRECS",$JOB,1,0)
KILL ^TMP("AMHVRECS",$JOB)
+5 IF '$TEST
SET VALMHDR(4)=" # PRV PATIENT NAME HRN LOC ACT PROB NARRATIVE"
+6 QUIT
+7 ;
INIT ;EP -- init variables and list array
+1 ;S VALMSG="Q - Quit ?? for more actions + next screen - prev screen"
+2 SET VALMSG=" ?? for more actions"
+3 ;gather up all records for display
DO GATHER^AMHLEL
+4 SET VALMCNT=AMHRCNT
+5 IF VALMCNT>11
SET VALMSG="+ for more contacts, - to back up ?? for more actions"
+6 QUIT
+7 ;
HELP ;EP -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL AMHRCNT,^TMP("AMHVRECS",$JOB)
+2 KILL VALMCC,VALMHDR
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
TEXT ;
+1 ;;BH Data Entry Module
+2 ;;
+3 ;;************************
+4 ;;* Update BH Visits *
+5 ;;************************
+6 ;;
+7 QUIT
DISPDG ;EP
+1 WRITE !!,"You are processing a record for the following sensitive patient:",!
+2 WRITE !?5,$PIECE(^DPT(AMHPAT,0),U,1),?40,"DOB: ",$$FMTE^XLFDT($$DOB^AUPNPAT(AMHPAT)),?65,"HRN: ",$$HRN^AUPNPAT(AMHPAT,DUZ(2))
+3 SET X=1
FOR
SET X=$ORDER(AMHRESU(X))
IF X'=+X
QUIT
WRITE !,$$CTR^AMHLEIN(AMHRESU(X))
+4 QUIT
