AMHNAVR ; IHS/CMI/LAB - REF FORM ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
D EN^XBVK("AMH")
W:$D(IOF) @IOF
W !!,$$CTR^AMHNAVRP("***** NAVAJO PSYCHIATRIC HOSPITALIZATION REFERRAL *****",80),!
S DIR(0)="S^A:Add a new Psychiatric Hospitalization Referral;E:Edit an Existing Psychiatric Hospitalization Referral;P:Print a Referral Form",DIR("A")="Action",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S AMHACT=Y
D @AMHACT
D XIT
Q
A ;
W:$D(IOF) @IOF
W !!,"This option should be used to add a visit to the BH system and then to",!,"complete a Psychiatric Referral Form.",!!
D EN^XBVK("AMH")
D GETPAT
I 'AMHPAT D XIT Q
1 ; -- add visit
D ^AMHLEIN
S AMHPATCE=1
S AMHNAVR=1
;get defaults
D GETTYPE^AMHLE
I $G(AMHPTYPE)="" D XIT Q
D GETDATE^AMHLE
I $G(AMHDATE)="" D XIT Q
S AMHVTYPE="R"
D ADD^AMHLEP2
I '$G(AMHR) W !!,"Record IEN missing!" D XIT Q
S AMHCC=$P($G(^AMHREC(AMHR,21)),U)
D ADDFORM
D SUIC^AMHLEA
D OTHER^AMHLEP2
D PCCLINK^AMHLEP2
D XIT
D EN2^AMHEKL
Q
;
GETPAT ;
K DIC,DFN S AMHPAT="" S DIC=9000001,DIC(0)="AEMQZ" D ^DIC I Y>0 S (AMHPAT,DFN)=+Y
Q
XIT ;
D EN^XBVK("AMH")
D KILL^AUPNPAT
D ^XBFMK
Q
ADDFORM ;
W !!,"Now creating referral form...."
W !,"Creating new record..." K DD,D0,DO,DINUM,DIC,DA,DR
S DIC(0)="EL",DIC="^AMHRNRF(",DLAYGO=9002011.11,DIADD=1,X=AMHDATE,DIC("DR")=".02////^S X=$G(AMHPAT);.03////"_AMHR
D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
I Y=-1 W !!,$C(7),$C(7),"Behavioral Health Referral form is NOT complete!! Deleting Record.",! D PAUSE^AMHLEP2 Q
S AMHREF=+Y
I AMHVTYPE="R" S DA=AMHREF,DDSFILE=9002011.11,DR="[AMH ADD NAV REFERRAL]" D ^DDS
;print form
S DIR(0)="Y",DIR("A")="Do you wish to print this referral form",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
I 'Y Q
S XBRC="",XBRP="^AMHNAVRP",XBNS="AMH",XBRX=""
D ^XBDBQUE
Q
P ;PRINT form
W !!,"Print a Psychiatric Hospitalization Referral Form",!!
D GETPAT
I 'AMHPAT D XIT Q
S AMHRDATE=""
S DIR(0)="D^::EP",DIR("A")="Enter Referral Date" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S AMHRDATE=Y
;get referral form
S AMHREF="",X=0 F S X=$O(^AMHRNRF("AC",AMHPAT,X)) Q:X'=+X I $P(^AMHRNRF(X,0),U)=AMHRDATE S AMHREF=X
I 'AMHREF W !!,"No referral form on file for that date." G P
S DIR(0)="Y",DIR("A")="Do you wish to print this referral form",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
S XBRC="",XBRP="^AMHNAVRP",XBNS="AMH",XBRX=""
D ^XBDBQUE
D XIT
Q
E ;EP
W !!,"Edit a Psychiatric Hospitalization Referral Form",!!
D GETPAT
I 'AMHPAT D XIT Q
S AMHRDATE=""
S DIR(0)="D^::EP",DIR("A")="Enter Referral Date" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S AMHRDATE=Y
;get referral form
S AMHREF="",X=0 F S X=$O(^AMHRNRF("AC",AMHPAT,X)) Q:X'=+X I $P(^AMHRNRF(X,0),U)=AMHRDATE S AMHREF=X
I 'AMHREF W !!,"No referral form on file for that date." G E
S DA=AMHREF,DDSFILE=9002011.11,DR="[AMH ADD NAV REFERRAL]" D ^DDS
S DIR(0)="Y",DIR("A")="Do you wish to print this referral form",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
I 'Y Q
S XBRC="",XBRP="^AMHNAVRP",XBNS="AMH",XBRX=""
D ^XBDBQUE
D XIT
Q
AMHNAVR ; IHS/CMI/LAB - REF FORM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 DO EN^XBVK("AMH")
+5 IF $DATA(IOF)
WRITE @IOF
+6 WRITE !!,$$CTR^AMHNAVRP("***** NAVAJO PSYCHIATRIC HOSPITALIZATION REFERRAL *****",80),!
+7 SET DIR(0)="S^A:Add a new Psychiatric Hospitalization Referral;E:Edit an Existing Psychiatric Hospitalization Referral;P:Print a Referral Form"
SET DIR("A")="Action"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
DO XIT
QUIT
+9 SET AMHACT=Y
+10 DO @AMHACT
+11 DO XIT
+12 QUIT
A ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,"This option should be used to add a visit to the BH system and then to",!,"complete a Psychiatric Referral Form.",!!
+3 DO EN^XBVK("AMH")
+4 DO GETPAT
+5 IF 'AMHPAT
DO XIT
QUIT
1 ; -- add visit
+1 DO ^AMHLEIN
+2 SET AMHPATCE=1
+3 SET AMHNAVR=1
+4 ;get defaults
+5 DO GETTYPE^AMHLE
+6 IF $GET(AMHPTYPE)=""
DO XIT
QUIT
+7 DO GETDATE^AMHLE
+8 IF $GET(AMHDATE)=""
DO XIT
QUIT
+9 SET AMHVTYPE="R"
+10 DO ADD^AMHLEP2
+11 IF '$GET(AMHR)
WRITE !!,"Record IEN missing!"
DO XIT
QUIT
+12 SET AMHCC=$PIECE($GET(^AMHREC(AMHR,21)),U)
+13 DO ADDFORM
+14 DO SUIC^AMHLEA
+15 DO OTHER^AMHLEP2
+16 DO PCCLINK^AMHLEP2
+17 DO XIT
+18 DO EN2^AMHEKL
+19 QUIT
+20 ;
GETPAT ;
+1 KILL DIC,DFN
SET AMHPAT=""
SET DIC=9000001
SET DIC(0)="AEMQZ"
DO ^DIC
IF Y>0
SET (AMHPAT,DFN)=+Y
+2 QUIT
XIT ;
+1 DO EN^XBVK("AMH")
+2 DO KILL^AUPNPAT
+3 DO ^XBFMK
+4 QUIT
ADDFORM ;
+1 WRITE !!,"Now creating referral form...."
+2 WRITE !,"Creating new record..."
KILL DD,D0,DO,DINUM,DIC,DA,DR
+3 SET DIC(0)="EL"
SET DIC="^AMHRNRF("
SET DLAYGO=9002011.11
SET DIADD=1
SET X=AMHDATE
SET DIC("DR")=".02////^S X=$G(AMHPAT);.03////"_AMHR
+4 DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+5 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health Referral form is NOT complete!! Deleting Record.",!
DO PAUSE^AMHLEP2
QUIT
+6 SET AMHREF=+Y
+7 IF AMHVTYPE="R"
SET DA=AMHREF
SET DDSFILE=9002011.11
SET DR="[AMH ADD NAV REFERRAL]"
DO ^DDS
+8 ;print form
+9 SET DIR(0)="Y"
SET DIR("A")="Do you wish to print this referral form"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+10 IF $DATA(DIRUT)
QUIT
+11 IF 'Y
QUIT
+12 SET XBRC=""
SET XBRP="^AMHNAVRP"
SET XBNS="AMH"
SET XBRX=""
+13 DO ^XBDBQUE
+14 QUIT
P ;PRINT form
+1 WRITE !!,"Print a Psychiatric Hospitalization Referral Form",!!
+2 DO GETPAT
+3 IF 'AMHPAT
DO XIT
QUIT
+4 SET AMHRDATE=""
+5 SET DIR(0)="D^::EP"
SET DIR("A")="Enter Referral Date"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
DO XIT
QUIT
+7 SET AMHRDATE=Y
+8 ;get referral form
+9 SET AMHREF=""
SET X=0
FOR
SET X=$ORDER(^AMHRNRF("AC",AMHPAT,X))
IF X'=+X
QUIT
IF $PIECE(^AMHRNRF(X,0),U)=AMHRDATE
SET AMHREF=X
+10 IF 'AMHREF
WRITE !!,"No referral form on file for that date."
GOTO P
+11 SET DIR(0)="Y"
SET DIR("A")="Do you wish to print this referral form"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+12 IF $DATA(DIRUT)
QUIT
+13 SET XBRC=""
SET XBRP="^AMHNAVRP"
SET XBNS="AMH"
SET XBRX=""
+14 DO ^XBDBQUE
+15 DO XIT
+16 QUIT
E ;EP
+1 WRITE !!,"Edit a Psychiatric Hospitalization Referral Form",!!
+2 DO GETPAT
+3 IF 'AMHPAT
DO XIT
QUIT
+4 SET AMHRDATE=""
+5 SET DIR(0)="D^::EP"
SET DIR("A")="Enter Referral Date"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
DO XIT
QUIT
+7 SET AMHRDATE=Y
+8 ;get referral form
+9 SET AMHREF=""
SET X=0
FOR
SET X=$ORDER(^AMHRNRF("AC",AMHPAT,X))
IF X'=+X
QUIT
IF $PIECE(^AMHRNRF(X,0),U)=AMHRDATE
SET AMHREF=X
+10 IF 'AMHREF
WRITE !!,"No referral form on file for that date."
GOTO E
+11 SET DA=AMHREF
SET DDSFILE=9002011.11
SET DR="[AMH ADD NAV REFERRAL]"
DO ^DDS
+12 SET DIR(0)="Y"
SET DIR("A")="Do you wish to print this referral form"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
QUIT
+14 IF 'Y
QUIT
+15 SET XBRC=""
SET XBRP="^AMHNAVRP"
SET XBNS="AMH"
SET XBRX=""
+16 DO ^XBDBQUE
+17 DO XIT
+18 QUIT
