AMHLE.m

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