- 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