AMHLENS.m

AMHLENS ; IHS/CMI/LAB - add no show record ;

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

 ;

 ;

 ;; ;

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.

GETTYPE ;EP

 S AMHADPTV=1

 I $G(AMHPATCE) 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

 I $D(DIRUT) D EOJ Q

 S AMHPTYPE=Y

GETDATE ;EP - GET DATE OF ENCOUNTER

 S AMHDATE=""

 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

ADDR ;EP

 I '$D(AMHDATE) W !!,"Date not entered." H 5 Q

 S AMHQUIT=0,AMHACTN=1

 S APCDOVRR=""

 S AMHQUIT=0,AMHACTN=1

 K DIC S DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHDATE,DIC("DR")=".03///^S X=DT;.19////"_DUZ_";.33////"_AMHVTYPE_";.28////"_DUZ_";.22///A;.21///^S X=DT"

 D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0

 I Y=-1 W !!,$C(7),$C(7),"Behavioral Health Record is NOT complete!!  Deleting Record.",! D PAUSE Q

 ;update multiple of user last update/date edited

 S AMHR=+Y

 S DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR

 D GETPAT D:'$G(AMHPAT) DEL Q:'$G(AMHPAT)  S DA=AMHR,DR=".08////"_AMHPAT,DIE="^AMHREC(" D CALLDIE^AMHLEIN

 D GETPROV I '$$PPINT^AMHUTIL(AMHR) W !,"No PRIMARY PROVIDER entered!! - Required element" D DEL Q

 S DA=AMHR,DDSFILE=9002011,DR="[AMHNS ADD RECORD]" D ^DDS

 I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!  ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG Q

 ;CHECK RECORD

 D GENPOV

 S AMHOKAY=0 D RECCHECK^AMHLE2 I AMHOKAY W !!,"Incomplete record!! Deleting record!!" D DEL Q

 I $G(AMHERROR) W !!,$C(7),$C(7),"PLEASE EDIT THIS RECORD!!",!!

 I $G(AMHADPTV) D REGULAR^AMHLEP2

 I $G(AMHADPTV) D OTHER^AMHLEA

 I $G(AMHADPTV) D PCCLINK^AMHLE2

 D EOJ

 Q

GENPOV ;EPgenerate pov of 8

 S X=$O(^AMHPROB("B",8,"")) I X="" W !!,"ERROR - NO PROBLEM 8" Q

 S DIR(0)="S^1:FAILED APPOINTMENT/NO SHOW;2:PATIENT CANCELLED, RESCHEDULED;3:PATIENT CANCELLED, NOT RESCHEDULED;4:PROVIDER CANCELLED, RESCHEDULED;5:PROVIDER CANCELLED, NOT RESCHEDULED;6:DID NOT WAIT TO BE SEEN"

 S DIR("A")="Enter Appropriate POV code",DIR("B")="1" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) W !!,"ERROR - NO POV CODE" Q

 S X=$S(Y=1:8,Y=2:8.1,Y=3:8.11,Y=4:8.2,Y=5:8.21,Y=6:8.3,1:8)

 S X=$O(^AMHPROB("B",X,0))

 I 'X W !,"ERROR - NO POV CODE" Q

 S DIC="^AMHRPRO(",DIC("DR")=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.04///"_$P(^AMHPROB(X,0),U,2),DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.01 K DD,DO,D0 D FILE^DICN

 I Y=-1 W !!,"Creating POV Failed!",$C(7),$C(7) H 2

 D ^XBFMK K DIADD,DLAYGO

 Q

GETPROV ;get providers

 W !!

 K DIR,DIC,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y S DIR("B")=$P(^VA(200,DUZ,0),U),DIR(0)="9002011.02,.01O",DIR("A")="Enter PRIMARY PROVIDER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 Q:Y=""

 S X=+Y,DIC("DR")=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.04///PRIMARY",DIC="^AMHRPROV(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.02 K DD,DO D FILE^DICN K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO

 I Y=-1 W !!,"Creating Primary Provider entry failed!!!",$C(7),$C(7) H 2

 Q

GETPAT ;EP

 D ^XBFMK

 S AMHC=0

GETPAT1 ;

 S AMHPAT=""

 S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD

 I Y<0 K AMHC Q

 S AMHPAT=+Y

 S X=AMHPAT D ^AMHPEDIT I '$D(X) S AMHC=AMHC+1 G GETPAT1

 I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2

 W !?25,"Ok" S %=1 D YN^DICN I %'=1 S AMHPAT="" K AMHC Q

 K AMHC

 Q

DEL ;EP

 S AMHVDLT=$P(^AMHREC(AMHR,0),U,16)

 S AMHRDEL=AMHR

 D EN^AMHLEDEL

 W !,"Record deleted." D PAUSE

 Q

PAUSE ;EP

 S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q

EOJ ;EOJ CLEANUP

 K AMHVTYPE,AMHVDLT

 ;D EN^AMHEKL

 D ^XBFMK

 Q

TEXT ;

 ;;BH Data Entry Module

 ;;

 ;;***************************

 ;;* Enter a DNKA BH Visit *

 ;;***************************

 ;;

 Q

AMHLENS   ; IHS/CMI/LAB - add no show record ;

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

 +2       ;

 +3       ;

 +4       ;; ;

START     ; Write Header

 +1       ; -- kill all vars before starting

           DO EN^AMHEKL

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        FOR J=1:1:5

               SET X=$PIECE($TEXT(TEXT+J),";;",2)

               WRITE !?80-$LENGTH(X)\2,X

 +4        KILL X,J

 +5        WRITE !!

 +6       ;Initialize vars, etc.

           DO ^AMHLEIN

GETTYPE   ;EP

 +1        SET AMHADPTV=1

 +2        IF $GET(AMHPATCE)

               IF $DATA(IOF)

                   WRITE @IOF

 +3        SET AMHPTYPE=""

 +4        WRITE !,"Please enter the appropriate set of defaults to be used in Data entry.",!,"This applies to default clinic, location, community and program.",!

 +5        SET DIR(0)="S^M:MENTAL HEALTH DEFAULTS;S:SOCIAL SERVICES DEFAULTS"

           SET DIR("A")="Which set of defaults do you want to use in Data Entry"

           KILL DA

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               DO EOJ

               QUIT 

 +7        SET AMHPTYPE=Y

GETDATE   ;EP - GET DATE OF ENCOUNTER

 +1        SET AMHDATE=""

 +2        WRITE !

 +3        SET AMHDATE=""

           SET DIR(0)="DO^:"_DT_":EPTX"

           SET DIR("A")="Enter ENCOUNTER DATE"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               QUIT 

 +5        SET AMHDATE=Y

ADDR      ;EP

 +1        IF '$DATA(AMHDATE)

               WRITE !!,"Date not entered."

               HANG 5

               QUIT 

 +2        SET AMHQUIT=0

           SET AMHACTN=1

 +3        SET APCDOVRR=""

 +4        SET AMHQUIT=0

           SET AMHACTN=1

 +5        KILL DIC

           SET DIC(0)="EL"

           SET DIC="^AMHREC("

           SET DLAYGO=9002011

           SET DIADD=1

           SET X=AMHDATE

           SET DIC("DR")=".03///^S X=DT;.19////"_DUZ_";.33////"_AMHVTYPE_";.28////"_DUZ_";.22///A;.21///^S X=DT"

 +6        DO FILE^DICN

           KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0

 +7        IF Y=-1

               WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health Record is NOT complete!!  Deleting Record.",!

               DO PAUSE

               QUIT 

 +8       ;update multiple of user last update/date edited

 +9        SET AMHR=+Y

 +10       SET DIE="^AMHREC("

           SET DA=AMHR

           SET DR="5100///NOW"

           SET DR(2,9002011.5101)=".02////^S X=DUZ"

           DO ^DIE

           KILL DIE,DA,DR

 +11       DO GETPAT

           IF '$GET(AMHPAT)

               DO DEL

           IF '$GET(AMHPAT)

               QUIT 

           SET DA=AMHR

           SET DR=".08////"_AMHPAT

           SET DIE="^AMHREC("

           DO CALLDIE^AMHLEIN

 +12       DO GETPROV

           IF '$$PPINT^AMHUTIL(AMHR)

               WRITE !,"No PRIMARY PROVIDER entered!! - Required element"

               DO DEL

               QUIT 

 +13       SET DA=AMHR

           SET DDSFILE=9002011

           SET DR="[AMHNS ADD RECORD]"

           DO ^DDS

 +14       IF $DATA(DIMSG)

               WRITE !!,"ERROR IN SCREENMAN FORM!!  ***NOTIFY PROGRAMMER***"

               SET AMHQUIT=1

               KILL DIMSG

               QUIT 

 +15      ;CHECK RECORD

 +16       DO GENPOV

 +17       SET AMHOKAY=0

           DO RECCHECK^AMHLE2

           IF AMHOKAY

               WRITE !!,"Incomplete record!! Deleting record!!"

               DO DEL

               QUIT 

 +18       IF $GET(AMHERROR)

               WRITE !!,$CHAR(7),$CHAR(7),"PLEASE EDIT THIS RECORD!!",!!

 +19       IF $GET(AMHADPTV)

               DO REGULAR^AMHLEP2

 +20       IF $GET(AMHADPTV)

               DO OTHER^AMHLEA

 +21       IF $GET(AMHADPTV)

               DO PCCLINK^AMHLE2

 +22       DO EOJ

 +23       QUIT 

GENPOV    ;EPgenerate pov of 8

 +1        SET X=$ORDER(^AMHPROB("B",8,""))

           IF X=""

               WRITE !!,"ERROR - NO PROBLEM 8"

               QUIT 

 +2        SET DIR(0)="S^1:FAILED APPOINTMENT/NO SHOW;2:PATIENT CANCELLED, RESCHEDULED;3:PATIENT CANCELLED, NOT RESCHEDULED;4:PROVIDER CANCELLED, RESCHEDULED;5:PROVIDER CANCELLED, NOT RESCHEDULED;6:DID NOT WAIT TO BE SEEN"

 +3        SET DIR("A")="Enter Appropriate POV code"

           SET DIR("B")="1"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               WRITE !!,"ERROR - NO POV CODE"

               QUIT 

 +5        SET X=$SELECT(Y=1:8,Y=2:8.1,Y=3:8.11,Y=4:8.2,Y=5:8.21,Y=6:8.3,1:8)

 +6        SET X=$ORDER(^AMHPROB("B",X,0))

 +7        IF 'X

               WRITE !,"ERROR - NO POV CODE"

               QUIT 

 +8        SET DIC="^AMHRPRO("

           SET DIC("DR")=".02////"_$GET(AMHPAT)_";.03////"_AMHR_";.04///"_$PIECE(^AMHPROB(X,0),U,2)

           SET DIC(0)="MLQ"

           SET DIADD=1

           SET DLAYGO=9002011.01

           KILL DD,DO,D0

           DO FILE^DICN

 +9        IF Y=-1

               WRITE !!,"Creating POV Failed!",$CHAR(7),$CHAR(7)

               HANG 2

 +10       DO ^XBFMK

           KILL DIADD,DLAYGO

 +11       QUIT 

GETPROV   ;get providers

 +1        WRITE !!

 +2        KILL DIR,DIC,DA,DTOUT,DIRUT,DUOUT,DIC,X,Y

           SET DIR("B")=$PIECE(^VA(200,DUZ,0),U)

           SET DIR(0)="9002011.02,.01O"

           SET DIR("A")="Enter PRIMARY PROVIDER"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        IF Y=""

               QUIT 

 +5        SET X=+Y

           SET DIC("DR")=".02////"_$GET(AMHPAT)_";.03////"_AMHR_";.04///PRIMARY"

           SET DIC="^AMHRPROV("

           SET DIC(0)="MLQ"

           SET DIADD=1

           SET DLAYGO=9002011.02

           KILL DD,DO

           DO FILE^DICN

           KILL DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO

 +6        IF Y=-1

               WRITE !!,"Creating Primary Provider entry failed!!!",$CHAR(7),$CHAR(7)

               HANG 2

 +7        QUIT 

GETPAT    ;EP

 +1        DO ^XBFMK

 +2        SET AMHC=0

GETPAT1   ;

 +1        SET AMHPAT=""

 +2        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA,DR,DLAYGO,DIADD

 +3        IF Y<0

               KILL AMHC

               QUIT 

 +4        SET AMHPAT=+Y

 +5        SET X=AMHPAT

           DO ^AMHPEDIT

           IF '$DATA(X)

               SET AMHC=AMHC+1

               GOTO GETPAT1

 +6        IF $GET(AUPNDOD)]""

               WRITE !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!!

               HANG 2

 +7        WRITE !?25,"Ok"

           SET %=1

           DO YN^DICN

           IF %'=1

               SET AMHPAT=""

               KILL AMHC

               QUIT 

 +8        KILL AMHC

 +9        QUIT 

DEL       ;EP

 +1        SET AMHVDLT=$PIECE(^AMHREC(AMHR,0),U,16)

 +2        SET AMHRDEL=AMHR

 +3        DO EN^AMHLEDEL

 +4        WRITE !,"Record deleted."

           DO PAUSE

 +5        QUIT 

PAUSE     ;EP

 +1        SET DIR(0)="EO"

           SET DIR("A")="Press enter to continue...."

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        QUIT 

EOJ       ;EOJ CLEANUP

 +1        KILL AMHVTYPE,AMHVDLT

 +2       ;D EN^AMHEKL

 +3        DO ^XBFMK

 +4        QUIT 

TEXT      ;

 +1       ;;BH Data Entry Module

 +2       ;;

 +3       ;;***************************

 +4       ;;* Enter a DNKA BH Visit *

 +5       ;;***************************

 +6       ;;

 +7        QUIT