- 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
