AMHLEIC.m

AMHLEIC ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 ;info/contact RDE mode

IC ;EP

 D HEADER^AMHLEA

 W !,"Entering Info/Contact Record type",!

 I '$D(AMHPATCE) K AMHPAT

 W !,"Creating new record..." K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHDATE,DIC("DR")="1111////1" 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

 S AMHR=+Y,DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR

 D GETPROV  ;get primary provider

 I '$$PPINT^AMHUTIL(AMHR) W !,"No PRIMARY PROVIDER entered!! - Required element" D DEL^AMHLEA Q

 D GETPAT^AMHLEA D:'$G(AMHPAT) DEL^AMHLEA Q:'$G(AMHPAT)  S DA=AMHR,DR=".08////"_AMHPAT,DIE="^AMHREC(" D CALLDIE^AMHLEIN

 W ! S DIE="^AMHREC(",DR="3101INFORMATION",DA=AMHR D CALLDIE^AMHLEIN

 D ^AMHLEPOV

 I '$D(^AMHRPRO("AD",AMHR)) W !!,"No Purpose of Visit.. Incomplete record!!  Deleting record!!" D DEL^AMHLEA Q

 S DIE("NO^")="",DA=AMHR,DIE="^AMHREC(",DR="[AMH ADD INFO/CONTACT]" D CALLDIE^AMHLEIN

 S AMHOKAY=0 D RECCHECK^AMHLE2 I AMHOKAY W !,"Incomplete record!! Deleting record!!" D DEL^AMHLEA Q

 D REGULAR^AMHLEP2

 I $P(^AMHREC(AMHR,0),U,8)]"" D OTHER^AMHLEA

 D PCCLINK^AMHLEA

 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

PAUSE ;EP

 S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q

AMHLEIC   ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ;info/contact RDE mode

IC        ;EP

 +1        DO HEADER^AMHLEA

 +2        WRITE !,"Entering Info/Contact Record type",!

 +3        IF '$DATA(AMHPATCE)

               KILL AMHPAT

 +4        WRITE !,"Creating new record..."

           KILL DD,D0,DO,DINUM,DIC,DA,DR

           SET DIC(0)="EL"

           SET DIC="^AMHREC("

           SET DLAYGO=9002011

           SET DIADD=1

           SET X=AMHDATE

           SET DIC("DR")="1111////1"

           DO FILE^DICN

           KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0

 +5        IF Y=-1

               WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health Record is NOT complete!!  Deleting Record.",!

               DO PAUSE

               QUIT 

 +6        SET AMHR=+Y

           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

 +7       ;get primary provider

           DO GETPROV

 +8        IF '$$PPINT^AMHUTIL(AMHR)

               WRITE !,"No PRIMARY PROVIDER entered!! - Required element"

               DO DEL^AMHLEA

               QUIT 

 +9        DO GETPAT^AMHLEA

           IF '$GET(AMHPAT)

               DO DEL^AMHLEA

           IF '$GET(AMHPAT)

               QUIT 

           SET DA=AMHR

           SET DR=".08////"_AMHPAT

           SET DIE="^AMHREC("

           DO CALLDIE^AMHLEIN

 +10       WRITE !

           SET DIE="^AMHREC("

           SET DR="3101INFORMATION"

           SET DA=AMHR

           DO CALLDIE^AMHLEIN

 +11       DO ^AMHLEPOV

 +12       IF '$DATA(^AMHRPRO("AD",AMHR))

               WRITE !!,"No Purpose of Visit.. Incomplete record!!  Deleting record!!"

               DO DEL^AMHLEA

               QUIT 

 +13       SET DIE("NO^")=""

           SET DA=AMHR

           SET DIE="^AMHREC("

           SET DR="[AMH ADD INFO/CONTACT]"

           DO CALLDIE^AMHLEIN

 +14       SET AMHOKAY=0

           DO RECCHECK^AMHLE2

           IF AMHOKAY

               WRITE !,"Incomplete record!! Deleting record!!"

               DO DEL^AMHLEA

               QUIT 

 +15       DO REGULAR^AMHLEP2

 +16       IF $PIECE(^AMHREC(AMHR,0),U,8)]""

               DO OTHER^AMHLEA

 +17       DO PCCLINK^AMHLEA

 +18       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 

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