AMHLEGP1 ; IHS/CMI/LAB - GROUP FORM DATA ENTRY CREATE RECORD ;
;;4.0;IHS BEHAVIORAL HEALTH;**8**;JUN 02, 2010;Build 7
;
;
;loop and get patients until AMHNUM
;create mhss record calling DIE with [AMH CREATE RECORD]
START ;EP - called from AMHLEGP
S (AMHQUIT,AMHHIT)=0
F AMHLEGPI=1:1:AMHNUM D PROCESS Q:AMHQUIT
D EXIT
Q
PROCESS ;
S AMHPAT=""
W !
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC
S AMHPAT=+Y
I Y<0 D ERROR Q:AMHQUIT
I +AMHPAT<0 G PROCESS
I $G(AUPNDOD)]"" W !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!! H 2
W !?25,"Ok" S %=1 D YN^DICN G:%'=1 PROCESS
S AMHPAT=+Y
I AMHPAT,'$$ALLOWP^AMHUTIL(DUZ,AMHPAT) D NALLOWP^AMHUTIL D PAUSE^AMHLEA G PROCESS
S AMHHIT=AMHHIT+1
CREATE ;create mhss record
S AMHACTN=1
W !!,"Creating new record for ",$P(^DPT(AMHPAT,0),U),"." K DD,D0,DO,DIC,DA,DR S DIC("DR")="",DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHDATE 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,^XBFMK Q
S (DA,AMHR)=+Y,AMHAWIXX="A",DIE="^AMHREC(",DR="[AMH ADD RECORD NO INTERACT]" D CALLDIE^AMHLEIN K AMHAWIXX
I $D(Y) W !!,"ERROR -- Incomplete record!! Deleting record!!" D DEL Q
S DA=AMHR,DIE="^AMHREC(",DR="1117////"_$$HL^AMHUTIL2($$VALI^XBDIQ1(9002011,AMHR,.02)) D ^DIE K DIE,DA,DR
S AMHVTYPE=$P(^AMHREC(AMHR,0),U,33)
PROV ;create provider entries
S AMHX=0 F S AMHX=$O(AMHPROV(AMHX)) Q:AMHX'=+AMHX D
.K DD,D0,DO,DIC,DA,DR S DIC="^AMHRPROV(",DIC(0)="EL",DLAYGO=9002011.02,DIADD=1,X=$P(AMHPROV(AMHX),U),DIC("DR")=".02////^S X=AMHPAT;.03////^S X=AMHR;.04///^S X=$P(AMHPROV(AMHX),U,2)" D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,DO
.I Y<0 W !!,"Creating provider record failed.!! Notify site manager!",!!
POV ;create pov records
S AMHX=0 F S AMHX=$O(AMHPOV(AMHX)) Q:AMHX'=+AMHX D
.K DD,D0,DO,DIC,DA,DR S DIC="^AMHRPRO(",DIC(0)="EL",DLAYGO=9002011.01,DIADD=1,X=$P(AMHPOV(AMHX),U),DIC("DR")=".02////^S X=AMHPAT;.03////^S X=AMHR;.04////^S X=$P(AMHPOV(AMHX),U,2)" D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,DO
.I Y<0 W !!,"Creating pov record failed.!! Notify site manager!",!!
S AMHOKAY=0 D RECCHECK^AMHLE2 I AMHOKAY W !,"Incomplete record!! Deleting record!!" D DEL Q
D EP2^AMHLEPOV
CPT ;
S AMHX=0 F S AMHX=$O(AMHCPT(AMHX)) Q:AMHX'=+AMHX D
.K DD,D0,DO,DIC,DA,DR S DIC="^AMHRPROC(",DIC(0)="EL",DLAYGO=9002011.04,DIADD=1,X=$P(AMHCPT(AMHX),U),DIC("DR")=".02////^S X=AMHPAT;.03////^S X=AMHR" D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,DO
.I Y<0 W !!,"Creating cpt record failed.!! Notify site manager!",!!
EDUC ;
S AMHX=0 F S AMHX=$O(AMHEDUC(AMHX)) Q:AMHX'=+AMHX D
.K DD,D0,DO,DIC,DA,DR S DIC="^AMHREDU(",DIC(0)="EL",DLAYGO=9002011.05,DIADD=1
.S X=$P(AMHEDUC(AMHX),U),DIC("DR")=".02////^S X=AMHPAT;.03////^S X=AMHR;.04///"_$P(AMHEDUC(AMHX),U,2)_";.05///G;.06///"_$P(AMHEDUC(AMHX),U,3)_";.07///"_$P(AMHEDUC(AMHX),U,4)_";.08///4;1101///"_$P(AMHEDUC(AMHX),U,5)
.D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,DO
.I Y<0 W !!,"Creating PT ED record failed.!! Notify site manager!",!!
W !
SOAP ;
W ! S DIE="^AMHREC(",DR=$S($P(^AMHSITE(DUZ(2),0),U,16):"3101;8101",1:"8101"),DA=AMHR D CALLDIE^AMHLEIN
;DO PCC LINK
D PCCLINK^AMHLE2
S AMHLEGP("RECS ADDED",AMHHIT)=AMHR
Q
EXIT ;clean up and exit
K DIC,DR,DA,X,Y,DIU,DIU,D0,DO,DI
K AMHHIT,AMHX
K DIR,X,Y,DIC,DR,DA,D0,DO,DIZ,D
Q
ERROR ;
W !!,$C(7),$C(7),"You have NOT completed entry of all of the ",AMHNUM," patients!!",!,"This means that you MUST enter each of the remaining visits individually,",!,"using ",AMHTIME\AMHNUM," minutes activity time for each patient.",!!!
S DIR(0)="Y",DIR("A")="Are you sure you want to QUIT this group entry",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) S AMHQUIT=1 Q
I Y S AMHQUIT=1 Q
Q
INFORM ;EP
W:$D(IOF) @IOF
D TERM^VALM0
W !!,IORVON,"The GRP option will be deactivated in the next application release.",!,"Users are encouraged to begin utilizing the option GP Group Form Data",!,"Entry Using Group Definition.",IORVOFF
D PAUSE
W !!,"This is the GROUP Data Entry Option: You will be asked to enter the total",!,"number of visits , the total Activity Time for ALL Patients listed on the",!,"Group Form,"
W "and all other pertinent information required for a visit.",!!
W " .....You MUST complete ALL entries prior to leaving this option.....",!
Q
XIT ;EP
K AMHDATE,AMHLOC,AMHPROG,AMHPROV,AMHCOMM,AMHACT,AMHCONT,AMHPOVS,AMHPOVP,AMHC,AMHPOV,AMHNARR,AMHTIME,AMHNUM,AMHPOVP,AMHBEEP,AMHGOT,AMHLPCC,AMHVISIT,AMHLEGPI,AMHLEIN,AMHOKAY,AMHPAT,AMHQUIT,AMHREC,AMHDASH,AMHBT
K AMHR,AMHACTN,AMHNUM,AMHCLN,AMHTOD,AMHLEGP,AMHPTYPE,APCDOVRR,AMHOL,AMHGROUP
K AMHHRN,AMHL,AMHLPCCT,AMHR0,AMHTICL,AMHTNRQ,AMHTQ,AMHTTXT
D KILL^AUPNPAT
Q
PAUSE ;
S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
DEL ;
S AMHRDEL=AMHR
D EN^AMHLEDEL
D PAUSE
Q
AMHLEGP1 ; IHS/CMI/LAB - GROUP FORM DATA ENTRY CREATE RECORD ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**8**;JUN 02, 2010;Build 7
+2 ;
+3 ;
+4 ;loop and get patients until AMHNUM
+5 ;create mhss record calling DIE with [AMH CREATE RECORD]
START ;EP - called from AMHLEGP
+1 SET (AMHQUIT,AMHHIT)=0
+2 FOR AMHLEGPI=1:1:AMHNUM
DO PROCESS
IF AMHQUIT
QUIT
+3 DO EXIT
+4 QUIT
PROCESS ;
+1 SET AMHPAT=""
+2 WRITE !
+3 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+4 SET AMHPAT=+Y
+5 IF Y<0
DO ERROR
IF AMHQUIT
QUIT
+6 IF +AMHPAT<0
GOTO PROCESS
+7 IF $GET(AUPNDOD)]""
WRITE !!?10,"***** PATIENT'S DATE OF DEATH IS ",$$FMTE^XLFDT(AUPNDOD),!!
HANG 2
+8 WRITE !?25,"Ok"
SET %=1
DO YN^DICN
IF %'=1
GOTO PROCESS
+9 SET AMHPAT=+Y
+10 IF AMHPAT
IF '$$ALLOWP^AMHUTIL(DUZ,AMHPAT)
DO NALLOWP^AMHUTIL
DO PAUSE^AMHLEA
GOTO PROCESS
+11 SET AMHHIT=AMHHIT+1
CREATE ;create mhss record
+1 SET AMHACTN=1
+2 WRITE !!,"Creating new record for ",$PIECE(^DPT(AMHPAT,0),U),"."
KILL DD,D0,DO,DIC,DA,DR
SET DIC("DR")=""
SET DIC(0)="EL"
SET DIC="^AMHREC("
SET DLAYGO=9002011
SET DIADD=1
SET X=AMHDATE
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+3 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health Record is NOT complete!! Deleting Record.",!
DO PAUSE
DO ^XBFMK
QUIT
+4 SET (DA,AMHR)=+Y
SET AMHAWIXX="A"
SET DIE="^AMHREC("
SET DR="[AMH ADD RECORD NO INTERACT]"
DO CALLDIE^AMHLEIN
KILL AMHAWIXX
+5 IF $DATA(Y)
WRITE !!,"ERROR -- Incomplete record!! Deleting record!!"
DO DEL
QUIT
+6 SET DA=AMHR
SET DIE="^AMHREC("
SET DR="1117////"_$$HL^AMHUTIL2($$VALI^XBDIQ1(9002011,AMHR,.02))
DO ^DIE
KILL DIE,DA,DR
+7 SET AMHVTYPE=$PIECE(^AMHREC(AMHR,0),U,33)
PROV ;create provider entries
+1 SET AMHX=0
FOR
SET AMHX=$ORDER(AMHPROV(AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+2 KILL DD,D0,DO,DIC,DA,DR
SET DIC="^AMHRPROV("
SET DIC(0)="EL"
SET DLAYGO=9002011.02
SET DIADD=1
SET X=$PIECE(AMHPROV(AMHX),U)
SET DIC("DR")=".02////^S X=AMHPAT;.03////^S X=AMHR;.04///^S X=$P(AMHPROV(AMHX),U,2)"
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,DO
+3 IF Y<0
WRITE !!,"Creating provider record failed.!! Notify site manager!",!!
End DoDot:1
POV ;create pov records
+1 SET AMHX=0
FOR
SET AMHX=$ORDER(AMHPOV(AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+2 KILL DD,D0,DO,DIC,DA,DR
SET DIC="^AMHRPRO("
SET DIC(0)="EL"
SET DLAYGO=9002011.01
SET DIADD=1
SET X=$PIECE(AMHPOV(AMHX),U)
SET DIC("DR")=".02////^S X=AMHPAT;.03////^S X=AMHR;.04////^S X=$P(AMHPOV(AMHX),U,2)"
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,DO
+3 IF Y<0
WRITE !!,"Creating pov record failed.!! Notify site manager!",!!
End DoDot:1
+4 SET AMHOKAY=0
DO RECCHECK^AMHLE2
IF AMHOKAY
WRITE !,"Incomplete record!! Deleting record!!"
DO DEL
QUIT
+5 DO EP2^AMHLEPOV
CPT ;
+1 SET AMHX=0
FOR
SET AMHX=$ORDER(AMHCPT(AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+2 KILL DD,D0,DO,DIC,DA,DR
SET DIC="^AMHRPROC("
SET DIC(0)="EL"
SET DLAYGO=9002011.04
SET DIADD=1
SET X=$PIECE(AMHCPT(AMHX),U)
SET DIC("DR")=".02////^S X=AMHPAT;.03////^S X=AMHR"
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,DO
+3 IF Y<0
WRITE !!,"Creating cpt record failed.!! Notify site manager!",!!
End DoDot:1
EDUC ;
+1 SET AMHX=0
FOR
SET AMHX=$ORDER(AMHEDUC(AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+2 KILL DD,D0,DO,DIC,DA,DR
SET DIC="^AMHREDU("
SET DIC(0)="EL"
SET DLAYGO=9002011.05
SET DIADD=1
+3 SET X=$PIECE(AMHEDUC(AMHX),U)
SET DIC("DR")=".02////^S X=AMHPAT;.03////^S X=AMHR;.04///"_$PIECE(AMHEDUC(AMHX),U,2)_";.05///G;.06///"_$PIECE(AMHEDUC(AMHX),U,3)_";.07///"_$PIECE(AMHEDUC(AMHX),U,4)_";.08///4;1101///"_$PIECE(AMHEDUC(AMHX),U,5)
+4 DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,DO
+5 IF Y<0
WRITE !!,"Creating PT ED record failed.!! Notify site manager!",!!
End DoDot:1
+6 WRITE !
SOAP ;
+1 WRITE !
SET DIE="^AMHREC("
SET DR=$SELECT($PIECE(^AMHSITE(DUZ(2),0),U,16):"3101;8101",1:"8101")
SET DA=AMHR
DO CALLDIE^AMHLEIN
+2 ;DO PCC LINK
+3 DO PCCLINK^AMHLE2
+4 SET AMHLEGP("RECS ADDED",AMHHIT)=AMHR
+5 QUIT
EXIT ;clean up and exit
+1 KILL DIC,DR,DA,X,Y,DIU,DIU,D0,DO,DI
+2 KILL AMHHIT,AMHX
+3 KILL DIR,X,Y,DIC,DR,DA,D0,DO,DIZ,D
+4 QUIT
ERROR ;
+1 WRITE !!,$CHAR(7),$CHAR(7),"You have NOT completed entry of all of the ",AMHNUM," patients!!",!,"This means that you MUST enter each of the remaining visits individually,",!,"using ",AMHTIME\AMHNUM," minutes activity time for each patient.",!!!
+2 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to QUIT this group entry"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
SET AMHQUIT=1
QUIT
+4 IF Y
SET AMHQUIT=1
QUIT
+5 QUIT
INFORM ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 DO TERM^VALM0
+3 WRITE !!,IORVON,"The GRP option will be deactivated in the next application release.",!,"Users are encouraged to begin utilizing the option GP Group Form Data",!,"Entry Using Group Definition.",IORVOFF
+4 DO PAUSE
+5 WRITE !!,"This is the GROUP Data Entry Option: You will be asked to enter the total",!,"number of visits , the total Activity Time for ALL Patients listed on the",!,"Group Form,"
+6 WRITE "and all other pertinent information required for a visit.",!!
+7 WRITE " .....You MUST complete ALL entries prior to leaving this option.....",!
+8 QUIT
XIT ;EP
+1 KILL AMHDATE,AMHLOC,AMHPROG,AMHPROV,AMHCOMM,AMHACT,AMHCONT,AMHPOVS,AMHPOVP,AMHC,AMHPOV,AMHNARR,AMHTIME,AMHNUM,AMHPOVP,AMHBEEP,AMHGOT,AMHLPCC,AMHVISIT,AMHLEGPI,AMHLEIN,AMHOKAY,AMHPAT,AMHQUIT,AMHREC,AMHDASH,AMHBT
+2 KILL AMHR,AMHACTN,AMHNUM,AMHCLN,AMHTOD,AMHLEGP,AMHPTYPE,APCDOVRR,AMHOL,AMHGROUP
+3 KILL AMHHRN,AMHL,AMHLPCCT,AMHR0,AMHTICL,AMHTNRQ,AMHTQ,AMHTTXT
+4 DO KILL^AUPNPAT
+5 QUIT
PAUSE ;
+1 SET DIR(0)="EO"
SET DIR("A")="Press enter to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 QUIT
DEL ;
+1 SET AMHRDEL=AMHR
+2 DO EN^AMHLEDEL
+3 DO PAUSE
+4 QUIT
