AMHLEA2 ; IHS/CMI/LAB - ADD NEW CHR ACTIVITY RECORDS ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;add new records
;get all items for a record, check record, file record
;if not complete record, issue warning and delete record
BEGIN ;add adm record
W:$D(IOF) @IOF
W !!,"Update Case Tracking Visit Record",!
D GETTYPE
I AMHPTYPE="" D EXIT Q
D GETDATE
I AMHDATE="" D EXIT Q
D CREATE
D EXIT
Q
GETTYPE ;EP
S AMHPTYPE=""
S DIR(0)="S^M:MENTAL HEALTH DEFAULTS;S:SOCIAL SERVICES DEFAULTS;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER",DIR("A")="Which set of defaults do you want to use in Data Entry" K DA D ^DIR K DIR
Q:$D(DIRUT)
S AMHPTYPE=Y
Q
GETDATE ;EP - GET DATE OF ENCOUNTER
W !!
S AMHDATE="",DIR(0)="DO^:"_DT_":EPTX",DIR("A")="Enter ENCOUNTER DATE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S AMHDATE=Y
Q
CREATE ;EP
S AMHACTN=1
S APCDOVRR=""
D GETPAT
I '$G(AMHPAT) W !!,"No Patient Selected." D EXIT Q
K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHDATE,DIC("DR")=".03////"_DUZ_";.19////"_DT_";.21////"_DT_";.22////A;.08////"_$G(AMHPAT)_";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
S DA=AMHR,DDSFILE=9002011,DR="[AMH ADD CASE TRACKING REC]" D ^DDS
I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG Q
I '$D(^AMHRPRO("AD",AMHR))!('$D(^AMHRPROV("AD",AMHR))) W !!,"Incomplete record!! Deleting record!!" D DEL G EXIT
S AMHOKAY=0 D RECCHECK^AMHLE2 I AMHOKAY W !,"Incomplete record!! Deleting record!!" D DEL G EXIT
D EXIT
Q
GETPAT ;EP
D ^XBFMK
S AMHC=0
GETPAT1 ;
S AMHPAT=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD
I Y<0 K AMHC Q
S AMHPAT=+Y
S X=AMHPAT D ^AMHPEDIT I '$D(X) S AMHC=AMHC+1 G GETPAT1
W !?25,"Ok" S %=1 D YN^DICN I %'=1 S AMHPAT="" K AMHC Q
K AMHC
Q
EXIT ;
D ^XBFMK
D EN^XBVK("AMH")
Q
DEL ;EP
I $$IINTAKE^AMHLEDEL(AMHR) W !!,"This visit has an Initial Intake with Updates, it can not be deleted",!,"until the update documents have been deleted." D PAUSE Q
S AMHVDLT=$P(^AMHREC(AMHR,0),U,16)
S AMHRDEL=AMHR
D EN^AMHLEDEL
W !,"Record deleted." D PAUSE
Q
PAUSE ;EP
S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
GETPROV ;get providers
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
GETPOV ;
D EN^XBNEW("EP^AMHLEA1","AMH*")
Q
AMHLEA2 ; IHS/CMI/LAB - ADD NEW CHR ACTIVITY RECORDS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;add new records
+4 ;get all items for a record, check record, file record
+5 ;if not complete record, issue warning and delete record
BEGIN ;add adm record
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,"Update Case Tracking Visit Record",!
+3 DO GETTYPE
+4 IF AMHPTYPE=""
DO EXIT
QUIT
+5 DO GETDATE
+6 IF AMHDATE=""
DO EXIT
QUIT
+7 DO CREATE
+8 DO EXIT
+9 QUIT
GETTYPE ;EP
+1 SET AMHPTYPE=""
+2 SET DIR(0)="S^M:MENTAL HEALTH DEFAULTS;S:SOCIAL SERVICES DEFAULTS;C:CHEMICAL DEPENDENCY or ALCOHOL/SUBSTANCE ABUSE;O:OTHER"
SET DIR("A")="Which set of defaults do you want to use in Data Entry"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 SET AMHPTYPE=Y
+5 QUIT
GETDATE ;EP - GET DATE OF ENCOUNTER
+1 WRITE !!
+2 SET AMHDATE=""
SET DIR(0)="DO^:"_DT_":EPTX"
SET DIR("A")="Enter ENCOUNTER DATE"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 SET AMHDATE=Y
+5 QUIT
CREATE ;EP
+1 SET AMHACTN=1
+2 SET APCDOVRR=""
+3 DO GETPAT
+4 IF '$GET(AMHPAT)
WRITE !!,"No Patient Selected."
DO EXIT
QUIT
+5 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")=".03////"_DUZ_";.19////"_DT_";.21////"_DT_";.22////A;.08////"_$GET(AMHPAT)_";1111////1"
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+6 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health Record is NOT complete!! Deleting Record.",!
DO PAUSE
QUIT
+7 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
+8 DO GETPROV
+9 SET DA=AMHR
SET DDSFILE=9002011
SET DR="[AMH ADD CASE TRACKING REC]"
DO ^DDS
+10 IF $DATA(DIMSG)
WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
SET AMHQUIT=1
KILL DIMSG
QUIT
+11 IF '$DATA(^AMHRPRO("AD",AMHR))!('$DATA(^AMHRPROV("AD",AMHR)))
WRITE !!,"Incomplete record!! Deleting record!!"
DO DEL
GOTO EXIT
+12 SET AMHOKAY=0
DO RECCHECK^AMHLE2
IF AMHOKAY
WRITE !,"Incomplete record!! Deleting record!!"
DO DEL
GOTO EXIT
+13 DO EXIT
+14 QUIT
GETPAT ;EP
+1 DO ^XBFMK
+2 SET AMHC=0
GETPAT1 ;
+1 SET AMHPAT=""
+2 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DLAYGO,DIADD
+3 IF Y<0
KILL AMHC
QUIT
+4 SET AMHPAT=+Y
+5 SET X=AMHPAT
DO ^AMHPEDIT
IF '$DATA(X)
SET AMHC=AMHC+1
GOTO GETPAT1
+6 WRITE !?25,"Ok"
SET %=1
DO YN^DICN
IF %'=1
SET AMHPAT=""
KILL AMHC
QUIT
+7 KILL AMHC
+8 QUIT
EXIT ;
+1 DO ^XBFMK
+2 DO EN^XBVK("AMH")
+3 QUIT
DEL ;EP
+1 IF $$IINTAKE^AMHLEDEL(AMHR)
WRITE !!,"This visit has an Initial Intake with Updates, it can not be deleted",!,"until the update documents have been deleted."
DO PAUSE
QUIT
+2 SET AMHVDLT=$PIECE(^AMHREC(AMHR,0),U,16)
+3 SET AMHRDEL=AMHR
+4 DO EN^AMHLEDEL
+5 WRITE !,"Record deleted."
DO PAUSE
+6 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
GETPROV ;get providers
+1 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
+2 IF $DATA(DIRUT)
QUIT
+3 IF Y=""
QUIT
+4 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
+5 IF Y=-1
WRITE !!,"Creating Primary Provider entry failed!!!",$CHAR(7),$CHAR(7)
HANG 2
+6 QUIT
GETPOV ;
+1 DO EN^XBNEW("EP^AMHLEA1","AMH*")
+2 QUIT
