AMHLEP4 ; IHS/CMI/LAB - ADD NEW CHR ACTIVITY RECORDS ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
INTAKE ;EP
W:$D(IOF) @IOF
S DA=AMHR,DDSFILE=9002011,DR="[AMHVT ADD RECORD]" D ^DDS
I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG D DEL^AMHLEP2 Q
D CHECK I AMHOKAY W !!,"Incomplete record. Deleting record." D DEL^AMHLEP2 K AMHOKAY Q
K AMHOKAY
I1 ;
I '$D(^AMHRPRO("AD",AMHR)) W !!,"At least one POV IS REQUIRED." D G:$G(Y)="G" INTAKE D DEL^AMHLEP2 Q
.S DIR(0)="S^G:GO BACK AND ADD A POV;E:EXIT AND DELETE RECORD",DIR("A")="A POV must be entered, select action",DIR("B")="G" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S Y="" Q
.Q
D EP1^AMHLEI(AMHPAT,AMHR) ;INTAKE DATA COLLECTION
S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
;D CDST^AMHLEP2
D REGULAR^AMHLEP2
;remove auto opening of case per Denise patch 4 12-13-04
;I '$$CASE(DFN,AMHR,AMHPTYPE) D
;.W !!,"Opening Case for ",$P(^DPT(AMHPAT,0),U,1)
;.W !,"Creating new case..." K DD,D0,DO,DINUM,DIC,DA,DR S X=AMHDATE,DIC(0)="EL",DIC="^AMHPCASE(",DLAYGO=9002011.58,DIADD=1
;.S DIC("DR")=".02////"_DFN_";.11///^S X=DT;.03////^S X=$G(AMHPTYPE);.08////^S X=$$PPINT^AMHUTIL(AMHR)"
;.D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
;.I Y=-1 W !!,$C(7),$C(7),"Behavioral Health Case Record failed !! Deleting Record.",! D PAUSE^AMHLEA Q
;S AMHPC=+Y
S DIR(0)="Y",DIR("A")="Do you wish to update/review the BH Problem List",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G TP
I 'Y G TP
D MHPL^AMHLE2
TP ;remove this prompt per Denise 12-13-04 patch 4
;S DIR(0)="Y",DIR("A")="Do you wish to update/review the Patient's Treatment Plan",DIR("B")="N" KILL DA D ^DIR KILL DIR
;I $D(DIRUT) G OTH
;I 'Y G OTH
;D EP1^AMHLETP(AMHPAT)
;
OTH ;
D OTHER^AMHLEP2
D PCCLINK^AMHLEP2
Q
CASE(P,R,T) ;return 1 if case already opened
S U="^"
I '$G(P) Q ""
I '$G(R) Q ""
I $G(T)="" Q ""
NEW X,H S (X,H)=0 F S X=$O(^AMHPCASE("AA",P,9999999-$P($P(^AMHREC(R,0),U),"."),X)) Q:X'=+X I $P(^AMHPCASE(X,0),U,2)=T,$P(^AMHPCASE(X,0),U,8)=$$PPINT^AMHUTIL(R) S H=1
Q H
CHECK ;
S AMHOKAY=""
S AMHREC=^AMHREC(AMHR,0)
I $P(AMHREC,U,4)="" W !,"Location of Encounter Missing!" S AMHOKAY=1
I $P(AMHREC,U,5)="" W !,"Community of Service Missing!" S AMHOKAY=1
I $P(AMHREC,U,6)="" W !,"Activity Type Missing!" S AMHOKAY=1
I $P(AMHREC,U,7)="" W !,"Type of Contact Missing!" S AMHOKAY=1
S (X,Y)=0 F S X=$O(^AMHRPROV("AD",AMHR,X)) Q:X'=+X I $P(^AMHRPROV(X,0),U,4)="P" S Y=Y+1
I Y=0 W !,"No primary Provider!",$C(7),$C(7) S AMHOKAY=1
;IF PAT ACTIVITY AND PATIENT MISSING - ERROR
I $P(AMHREC,U,12)="" W !," WARNING: Activity Time Missing!" W $C(7) S AMHOKAY=1
Q
AMHLEP4 ; IHS/CMI/LAB - ADD NEW CHR ACTIVITY RECORDS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
INTAKE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 SET DA=AMHR
SET DDSFILE=9002011
SET DR="[AMHVT ADD RECORD]"
DO ^DDS
+3 IF $DATA(DIMSG)
WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
SET AMHQUIT=1
KILL DIMSG
DO DEL^AMHLEP2
QUIT
+4 DO CHECK
IF AMHOKAY
WRITE !!,"Incomplete record. Deleting record."
DO DEL^AMHLEP2
KILL AMHOKAY
QUIT
+5 KILL AMHOKAY
I1 ;
+1 IF '$DATA(^AMHRPRO("AD",AMHR))
WRITE !!,"At least one POV IS REQUIRED."
Begin DoDot:1
+2 SET DIR(0)="S^G:GO BACK AND ADD A POV;E:EXIT AND DELETE RECORD"
SET DIR("A")="A POV must be entered, select action"
SET DIR("B")="G"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET Y=""
QUIT
+4 QUIT
End DoDot:1
IF $GET(Y)="G"
GOTO INTAKE
DO DEL^AMHLEP2
QUIT
+5 ;INTAKE DATA COLLECTION
DO EP1^AMHLEI(AMHPAT,AMHR)
+6 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
+7 ;D CDST^AMHLEP2
+8 DO REGULAR^AMHLEP2
+9 ;remove auto opening of case per Denise patch 4 12-13-04
+10 ;I '$$CASE(DFN,AMHR,AMHPTYPE) D
+11 ;.W !!,"Opening Case for ",$P(^DPT(AMHPAT,0),U,1)
+12 ;.W !,"Creating new case..." K DD,D0,DO,DINUM,DIC,DA,DR S X=AMHDATE,DIC(0)="EL",DIC="^AMHPCASE(",DLAYGO=9002011.58,DIADD=1
+13 ;.S DIC("DR")=".02////"_DFN_";.11///^S X=DT;.03////^S X=$G(AMHPTYPE);.08////^S X=$$PPINT^AMHUTIL(AMHR)"
+14 ;.D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
+15 ;.I Y=-1 W !!,$C(7),$C(7),"Behavioral Health Case Record failed !! Deleting Record.",! D PAUSE^AMHLEA Q
+16 ;S AMHPC=+Y
+17 SET DIR(0)="Y"
SET DIR("A")="Do you wish to update/review the BH Problem List"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+18 IF $DATA(DIRUT)
GOTO TP
+19 IF 'Y
GOTO TP
+20 DO MHPL^AMHLE2
TP ;remove this prompt per Denise 12-13-04 patch 4
+1 ;S DIR(0)="Y",DIR("A")="Do you wish to update/review the Patient's Treatment Plan",DIR("B")="N" KILL DA D ^DIR KILL DIR
+2 ;I $D(DIRUT) G OTH
+3 ;I 'Y G OTH
+4 ;D EP1^AMHLETP(AMHPAT)
+5 ;
OTH ;
+1 DO OTHER^AMHLEP2
+2 DO PCCLINK^AMHLEP2
+3 QUIT
CASE(P,R,T) ;return 1 if case already opened
+1 SET U="^"
+2 IF '$GET(P)
QUIT ""
+3 IF '$GET(R)
QUIT ""
+4 IF $GET(T)=""
QUIT ""
+5 NEW X,H
SET (X,H)=0
FOR
SET X=$ORDER(^AMHPCASE("AA",P,9999999-$PIECE($PIECE(^AMHREC(R,0),U),"."),X))
IF X'=+X
QUIT
IF $PIECE(^AMHPCASE(X,0),U,2)=T
IF $PIECE(^AMHPCASE(X,0),U,8)=$$PPINT^AMHUTIL(R)
SET H=1
+6 QUIT H
CHECK ;
+1 SET AMHOKAY=""
+2 SET AMHREC=^AMHREC(AMHR,0)
+3 IF $PIECE(AMHREC,U,4)=""
WRITE !,"Location of Encounter Missing!"
SET AMHOKAY=1
+4 IF $PIECE(AMHREC,U,5)=""
WRITE !,"Community of Service Missing!"
SET AMHOKAY=1
+5 IF $PIECE(AMHREC,U,6)=""
WRITE !,"Activity Type Missing!"
SET AMHOKAY=1
+6 IF $PIECE(AMHREC,U,7)=""
WRITE !,"Type of Contact Missing!"
SET AMHOKAY=1
+7 SET (X,Y)=0
FOR
SET X=$ORDER(^AMHRPROV("AD",AMHR,X))
IF X'=+X
QUIT
IF $PIECE(^AMHRPROV(X,0),U,4)="P"
SET Y=Y+1
+8 IF Y=0
WRITE !,"No primary Provider!",$CHAR(7),$CHAR(7)
SET AMHOKAY=1
+9 ;IF PAT ACTIVITY AND PATIENT MISSING - ERROR
+10 IF $PIECE(AMHREC,U,12)=""
WRITE !," WARNING: Activity Time Missing!"
WRITE $CHAR(7)
SET AMHOKAY=1
+11 QUIT
