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
