Routine: AMHLEIVP

AMHLEIVP ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 16-JAN-1997 ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;; ;

EP1 ;EP - called from protocol

 D FULL^VALM1

 D GETPAT^AMHVRL

 I 'AMHPAT W !!,"No patient selected." D PAUSE^AMHLEA Q

 NEW DFN,AMHPROGT,AMHR

 S DFN=AMHPAT

 S AMHPROGT=""

 ;get program type

 I $G(AMHPTYPE)]"" S AMHPROGT=AMHPTYPE G SET

 S DIR(0)="S^M:MENTAL HEALTH;S:SOCIAL SERVICES;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER",DIR("A")="Which Program are you associated with" K DA D ^DIR K DIR

 I $D(DIRUT) W !,"No program selected." D PAUSE^AMHLEA Q

 S AMHPROGT=Y

 D EN

EP(AMHPAT) ;EP CALLED FROM DATA ENTRY

 Q:'$G(AMHPAT)

 NEW DFN,AMHPROGT,AMHR

 S DFN=AMHPAT

 S AMHPROGT=""

 ;get program type

 I $G(AMHPTYPE)]"" S AMHPROGT=AMHPTYPE G SET

 S DIR(0)="S^M:MENTAL HEALTH;S:SOCIAL SERVICES;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER",DIR("A")="Which Program are you associated with" K DA D ^DIR K DIR

 I $D(DIRUT) W !,"No program selected." D PAUSE^AMHLEA Q

 S AMHPROGT=Y

SET ;

 D EN

EN ;EP -- main entry point

 NEW AMHX,AMHINTK,AMHD,AMHRCNT,AMHLINE

 D EN^VALM("AMH VISIT INTAKE")

HDR ; -- header code

 D HDR^AMHLEIV

INIT ; -- init variables and list array

 S VALMSG="?? for more actions  + next screen  - prev screen"

 D GATHER ;gather up all records for display

 S VALMCNT=AMHLINE

D(D) ;EP

 I D="" Q ""

 Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)

GATHER ;

 D GATHER^AMHLEIV

PRINT ;

 S AMHRINTI=""

 D EN^VALM2(XQORNOD(0),"OS")

 I '$D(VALMY) W !,"No records selected." G EXIT

 S AMHR1=$O(VALMY(0)) I 'AMHR1 K AMHR1,VALMY,XQORNOD W !,"No record selected." G EXIT

 S (X,Y)=0 F  S X=$O(AMHINTK("IDX",X)) Q:X'=+X!(AMHRINTI)  I $O(AMHINTK("IDX",X,0))=AMHR1 S Y=$O(AMHINTK("IDX",X,0)),AMHRINTI=AMHINTK("IDX",X,Y)

 I '$D(^AMHRINTK(AMHRINTI,0)) W !,"Not a valid BH INTAKE." D PAUSE^AMHLEA D EXIT Q

 D FULL^VALM1

 D PRINT^AMHLEIV3

 D EXIT

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

EXIT ; -- exit code

 K AMHX,AMHINTK,AMHPC,AMHR1

 D TERM^VALM0

 S VALMBCK="R"

 D GATHER

 S VALMCNT=AMHLINE

 D HDR

 K X,Y,Z,I

EXPND ; -- expand code

AMHLEIVP  ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 16-JAN-1997 ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;; ;

 +3       ;

EP1       ;EP - called from protocol

 +1        DO FULL^VALM1

 +2        DO GETPAT^AMHVRL

 +3        IF 'AMHPAT

               WRITE !!,"No patient selected."

               DO PAUSE^AMHLEA

               QUIT

 +4        NEW DFN,AMHPROGT,AMHR

 +5        SET DFN=AMHPAT

 +6        SET AMHPROGT=""

 +7       ;get program type

 +8        IF $GET(AMHPTYPE)]""

               SET AMHPROGT=AMHPTYPE

               GOTO SET

 +9        SET DIR(0)="S^M:MENTAL HEALTH;S:SOCIAL SERVICES;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER"

           SET DIR("A")="Which Program are you associated with"

           KILL DA

           DO ^DIR

           KILL DIR

 +10       IF $DATA(DIRUT)

               WRITE !,"No program selected."

               DO PAUSE^AMHLEA

               QUIT

 +11       SET AMHPROGT=Y

 +12       DO EN

 +13       QUIT

 +14      ;

EP(AMHPAT) ;EP CALLED FROM DATA ENTRY

 +1        IF '$GET(AMHPAT)

               QUIT

 +2        NEW DFN,AMHPROGT,AMHR

 +3        SET DFN=AMHPAT

 +4        SET AMHPROGT=""

 +5       ;get program type

 +6        IF $GET(AMHPTYPE)]""

               SET AMHPROGT=AMHPTYPE

               GOTO SET

 +7        SET DIR(0)="S^M:MENTAL HEALTH;S:SOCIAL SERVICES;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER"

           SET DIR("A")="Which Program are you associated with"

           KILL DA

           DO ^DIR

           KILL DIR

 +8        IF $DATA(DIRUT)

               WRITE !,"No program selected."

               DO PAUSE^AMHLEA

               QUIT

 +9        SET AMHPROGT=Y

SET       ;

 +1        DO EN

 +2        QUIT

EN        ;EP -- main entry point

 +1        NEW AMHX,AMHINTK,AMHD,AMHRCNT,AMHLINE

 +2        DO EN^VALM("AMH VISIT INTAKE")

 +3        QUIT

 +4       ;

HDR       ; -- header code

 +1        DO HDR^AMHLEIV

 +2        QUIT

 +3       ;

INIT      ; -- init variables and list array

 +1        SET VALMSG="?? for more actions  + next screen  - prev screen"

 +2       ;gather up all records for display

           DO GATHER

 +3        SET VALMCNT=AMHLINE

 +4        QUIT

 +5       ;

D(D)      ;EP

 +1        IF D=""

               QUIT ""

 +2        QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)

 +3       ;

GATHER    ;

 +1        DO GATHER^AMHLEIV

 +2        QUIT

PRINT     ;

 +1        SET AMHRINTI=""

 +2        DO EN^VALM2(XQORNOD(0),"OS")

 +3        IF '$DATA(VALMY)

               WRITE !,"No records selected."

               GOTO EXIT

 +4        SET AMHR1=$ORDER(VALMY(0))

           IF 'AMHR1

               KILL AMHR1,VALMY,XQORNOD

               WRITE !,"No record selected."

               GOTO EXIT

 +5        SET (X,Y)=0

FOR

               SET X=$ORDER(AMHINTK("IDX",X))

               IF X'=+X!(AMHRINTI)

                   QUIT

               IF $ORDER(AMHINTK("IDX",X,0))=AMHR1

                   SET Y=$ORDER(AMHINTK("IDX",X,0))

                   SET AMHRINTI=AMHINTK("IDX",X,Y)

 +6        IF '$DATA(^AMHRINTK(AMHRINTI,0))

               WRITE !,"Not a valid BH INTAKE."

               DO PAUSE^AMHLEA

               DO EXIT

               QUIT

 +7        DO FULL^VALM1

 +8        DO PRINT^AMHLEIV3

 +9        DO EXIT

 +10       QUIT

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT

 +3       ;

EXIT      ; -- exit code

 +1        KILL AMHX,AMHINTK,AMHPC,AMHR1

 +2        DO TERM^VALM0

 +3        SET VALMBCK="R"

 +4        DO GATHER

 +5        SET VALMCNT=AMHLINE

 +6        DO HDR

 +7        KILL X,Y,Z,I

 +8        QUIT

 +9       ;

EXPND     ; -- expand code

 +1        QUIT

 +2       ;

AMHLEIVP.m