AMHNAVR.m

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