- 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
