AMHEYREX ; IHS/CMI/LAB - CMI ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
START ;Begin processing backload
W:$D(IOF) @IOF
W !,$$CTR($$LOC(),80),!
S X="***** BEHAVIORAL HEALTH RE-EXPORT IN A DATE RANGE *****" W !,$$CTR(X,80),!
W !,"ATTENTION: This option should ONLY be run if you have had",!,"a special request from IHS to re-send a large amount of previously",!,"exported data."
W !,"You should use the GEN and REDO options for all regularly scheduled exports.",!!
S T="INTRO" F J=1:1 S X=$T(@T+J),X=$P(X,";;",2) Q:X="END" W !,X
K J,X,T
;
CHKSITE ; CHECK SITE FILE
I '$D(^AMHSITE(DUZ(2),0)) W !!,"*** Site file has not been setup! ***" S AMH("QFLG")=1 Q
I '$D(^AMHSITE(DUZ(2))) W !!,"*** RUN LOCATION not in SITE file!" S AMH("QFLG")=2 Q
I $D(^XTMP("AMHEXRL",$J)) W !!,"xtmp nodes around from previous run......" D XIT Q
W !,"A file will be created and will be placed in the public directory where",!,"all other exports are placed. It will be called AMHX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_$$NLOG,!
I $D(^BHSXDATA) W !!,$C(7),$C(7),"BHSXDATA GLOBAL EXISTS FROM A PREVIOUS RUN - CANNOT CONTINUE" D XIT Q
GETDATES ;
W !,"Please enter the date range for which the records should be generated.",!
BD ;
S DIR(0)="D^::EP",DIR("A")="Enter Beginning Date",DIR("?")="Enter the beginning date." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
S AMHBD=Y
ED ;
S DIR(0)="DA^::EP",DIR("A")="Enter Ending Date: " D ^DIR K DIR,DA S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
I Y<AMHBD W !,"Ending date must be greater than or equal to beginning date!" G ED
S AMHED=Y
S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X
S AMHERR=0
W !!,"Log entry ",$$NLOG," will be created and records generated for visit",!,"date range ",$$FMTE^XLFDT(AMHBD)," to ",$$FMTE^XLFDT(AMHED),".",!
CONT ;continue or not
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !!,"Goodbye" D XIT Q
I 'Y W !!,"Goodbye" D XIT Q
S AMHRUN="NEW",AMHERR=0
D HOME^%ZIS S AMHBS=$S('$D(ZTQUEUED):IOBS,1:"")
D GENLOG ;generate new log entry
I $G(AMHERR) D XIT Q
D QUEUE
I $G(AMHERR) W !!,"Goodbye, no processing will occur.",! D XIT Q
I $D(AMHQUE) D XIT Q
;
PROCESS ;EP - process new run
S AMHCNT=$S('$D(ZTQUEUED):"X AMHCNT1 X AMHCNT2",1:"S AMHTOTV=AMHTOTV+1"),AMHCNT1="F AMHCNTL=1:1:$L(AMHTOTV)+1 W @AMHBS",AMHCNT2="S AMHTOTV=AMHTOTV+1 W AMHTOTV,"")"""
W:'$D(ZTQUEUED) !,"Generating transactions. Counting visits. (1)"
K ^BHSXDATA
S AMHSD=AMHSD_".9999"
;set counters
S (AMHTOTV,AMHTERR,AMHTOTR,AMHUSED,AMH("ENC"),AMH("COUNT"),AMH("ERROR COUNT"))=0 K AMHERRT
V ; Run by visit date
F S AMHSD=$O(^AMHREC("B",AMHSD)) Q:AMHSD=""!((AMHSD\1)>AMHED) D V1
SF ;
W:'$D(ZTQUEUED) !,"Generating suicide forms..."
S AMHCNTR=0,AMH("CONTROL DATE")="",AMHSFC=0
S AMHSD=AMHSD_".9999"
F S AMHSD=$O(^AMHPSUIC("AD",AMHSD)) Q:AMHSD=""!(AMHSD>AMHED) D
.S AMHSFIEN=0 F S AMHSFIEN=$O(^AMHPSUIC("AD",AMHSD,AMHSFIEN)) Q:AMHSFIEN'=+AMHSFIEN D
..I '$D(^AMHPSUIC(AMHSFIEN,0)) K ^AMHPSUIC("AD",AMHSD,AMHSFIEN) Q
..S AMHSREC=^AMHPSUIC(AMHSFIEN,0)
..S DFN=$P(AMHSREC,U,4)
..S AMHRIEN=$O(^AMHRECD("B","BH2",0))
..I 'AMHRIEN Q
..S AMHY=0,AMHTX="" F S AMHY=$O(^AMHRECD(AMHRIEN,11,"B",AMHY)) Q:AMHY'=+AMHY D
...S X=""
...S AMHZ=$O(^AMHRECD(AMHRIEN,11,"B",AMHY,0))
...Q:'$D(^AMHRECD(AMHRIEN,11,AMHZ,1))
...X ^AMHRECD(AMHRIEN,11,AMHZ,1)
...S $P(AMHTX,U,AMHY)=X
..S AMH("COUNT")=AMH("COUNT")+1,AMHSFC=AMHSFC+1
..S ^XTMP("AMHEXRL",$J,"SF",AMHSFIEN)=""
..S ^BHSXDATA(AMH("COUNT"))=AMHTX
S DA=AMHLOG,DIE="^AMHEXRL(",DR=".05///"_AMHTOTR_";.06///"_AMH("ERROR COUNT")_";.07///"_AMH("COUNT")_";.08///P;.12////"_AMHSFC_";.13////"_AMH("ENC") D ^DIE K DIE,DA,DR ;no error check
S ^AMHEXRL(AMHLOG,11,0)="^9001005.41A^0^0"
S X="",C=0 F S X=$O(AMHERRT(X)) Q:X="" S C=C+1,^AMHEXRL(AMHLOG,11,C,0)=X_"^"_AMHERRT(X)
S DA=AMHLOG,DIK="^AMHEXRL(" D IX1^DIK K DA,DIK
D WRITEF
D RESET
D XIT
Q
V1 ;go through each visit on this date
S AMHR="" F S AMHR=$O(^AMHREC("B",AMHSD,AMHR)) Q:AMHR'=+AMHR I $D(^AMHREC(AMHR,0)) S AMHVREC=^(0) D PROC
Q
PROC ;
GENREC ;generate record
K AMHT,AMHV,AMHE
D KILL^AUPNPAT
X AMHCNT
S AMHREC=^AMHREC(AMHR,0)
S AMHV("R DATE")=+AMHREC\1
S AMHTOTR=AMHTOTR+1
K AMHE,AMHTX D RECORD^AMHEYD2
D CNTBUILD
D ^XBFMK
Q
CNTBUILD ;count and build tx
I AMHE]"" S AMH("ERROR COUNT")=AMH("ERROR COUNT")+1 D ERRLOG Q
S ^XTMP("AMHEXRL",$J,"VISITS",AMHR)=""
S AMH("COUNT")=AMH("COUNT")+1
S ^BHSXDATA(AMH("COUNT"))=AMHTX
Q
QUEUE ;EP
K ZTSK
S DIR(0)="Y",DIR("A")="Do you want to QUEUE this to run at a later time",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y=1 D QUEUE1 Q
I AMHRUN="NEW",$D(DIRUT) S AMHERR=1 S DA=AMHLOG,DIK="^AMHEXRL(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA
I AMHRUN="REDO",$D(DIRUT) S AMHERR=1 Q
Q
QUEUE1 ;
S ZTRTN="PROCESS^AMHEYREX"
S ZTIO="",ZTDTH="",ZTDESC="BH EXPORT DATE RANGE" S ZTSAVE("AMH*")=""
D ^%ZTLOAD
W !!,$S($D(ZTSK):"Request Queued!!",1:"Request cancelled")
I '$D(ZTSK),AMHRUN="NEW" S AMHERR=1 S DA=AMHLOG,DIK="^AMHEXRL(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA Q
S AMHQUE=""
S DIE="^AMHEXRL(",DA=AMHLOG,DR=".08///Q" D ^DIE K DIE,DA,DR
K ZTSK
Q
WRITEF ;EP - write out flat file
I '$D(^BHSXDATA) W:'$D(ZTQUEUED) !!,"No transactions to send in that date range.",! Q
S XBGL="BHSXDATA"
S AMHTX="BH0"
S $P(AMHTX,U,2)=$P($G(^AUTTSITE(1,1)),U,3)
S $P(AMHTX,U,3)=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),1)),U,3)
S $P(AMHTX,U,4)=$P(^DIC(4,$P(^AUTTSITE(1,0),U),0),U)
S $P(AMHTX,U,5)=$$DATE^AMHUTIL(DT)
S $P(AMHTX,U,6)=$$DATE^AMHUTIL($P(^AMHEXRL(AMHLOG,0),U,3))
S $P(AMHTX,U,7)=$$DATE^AMHUTIL($P(^AMHEXRL(AMHLOG,0),U,4))
S $P(AMHTX,U,8)="R"
S $P(AMHTX,U,9)=$P(^AMHEXRL(AMHLOG,0),U,7)
S $P(AMHTX,U,10)=$P(^AMHEXRL(AMHLOG,0),U,13)
S $P(AMHTX,U,11)=$P(^AMHEXRL(AMHLOG,0),U,12)
S ^BHSXDATA(0)=AMHTX
S XBMED="F",XBFN="BHSX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_AMHLOG,XBTLE="SAVE OF BH BACKLOAD RECORDS GENERATED BY -"_$P(^VA(200,DUZ,0),U)
S XBF="",XBQ="N"
D ^XBGSAVE
;check for error
I XBFLG=-1 S AMHERR=1 W:'$D(ZTQUEUED) !,$C(7),$C(7),XBFLG(1) Q
K ^BHSXDATA
S DA=AMHLOG,DIE="^AMHEXRL(",DR=".08///S;.11////AMHX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_AMHLOG D ^DIE K DA,DIE,DR
K XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT
Q
GENLOG ;generate new log entry
W:'$D(ZTQUEUED) !,"Generating New Log entry.."
S Y=$$NLOG S X=""""_Y_"""",DIC="^AMHEXRL(",DIC(0)="L",DLAYGO=9002014.6,DIC("DR")=".02////"_DT_";.03////"_AMHBD_";.04////"_AMHED_";.09///`"_DUZ(2)
D ^DIC K DIC,DLAYGO,DR
I Y<0 W !!,$C(7),$C(7),"Error creating log entry." S AMHERR=1 Q
S AMHLOG=+Y
Q
XIT ;exit, eoj cleanup
D EOP
D ^XBFMK
D EN^XBVK("AMH")
D KILL^AUPNPAT
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR("A")="End of Job. Press Return.",DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
DATE(D) ;EP ;IHS/CMI/LAB - new date format - format date in YYYYMMDD format
I $G(D)="" Q ""
Q $E(D,1,3)+1700_$E(D,4,7)
;
;
NLOG() ;get next log
NEW X,L S (X,L)=0 F S X=$O(^AMHEXRL(X)) Q:X'=+X S L=X
Q L+1
INTRO ;introductory text
;;This program will generate Behavioral Health export records for a visit
;;date range that you enter. Suicide forms entered in the date range
;;will also be exported. A log entry will be created which will log
;;the number of visits processed and the number of records
;;generated.
;;
;;END
RESET ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE
W:'$D(ZTQUEUED) !,"RE-setting export date. (1)"
S AMHCNTR=0,AMHR=""
F S AMHR=$O(^XTMP("AMHEXRL",$J,"VISITS",AMHR)) Q:AMHR'=+AMHR D RESET1
D PURGESF
K ^XTMP("AMHEXRL",$J)
Q
;
RESET1 ; kill MHSS xref and set flag if tx 23 or 24 generated
S DIE="^AMHREC(",DA=AMHR,DR=".24///"_DT D CALLDIE^AMHLEIN
X AMHCNT
Q
;
PURGESF ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE
S AMHCNTR=0,AMHR=0
F S AMHR=$O(^XTMP("AMHEXRL",$J,"SF",AMHR)) Q:AMHR'=+AMHR D RESETSF
Q
RESETSF ; kill MHSS xref and set flag if tx 23 or 24 generated
S DA=AMHR,DIE="^AMHPSUIC(",DR=".23////"_DT D CALLDIE^AMHLEIN
X AMHCNT
Q
ERRLOG ;
S AMHERRTX=$O(^AMHERR("B",AMHE,0)) I AMHERRTX="" S AMHERRT("UNKNOWN ERROR")=$G(AMHERRT("UNKNOWN ERROR"))+1
S AMHERRTX=$P(^AMHERR(AMHERRTX,0),U,2) I AMHERRTX="" S AMHERRT("UNKNOWN ERROR")=$G(AMHERRT("UNKNOWN ERROR"))+1
S AMHERRT(AMHERRTX)=$G(AMHERRT(AMHERRTX))+1
Q
AMHEYREX ; IHS/CMI/LAB - CMI ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
START ;Begin processing backload
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC(),80),!
+3 SET X="***** BEHAVIORAL HEALTH RE-EXPORT IN A DATE RANGE *****"
WRITE !,$$CTR(X,80),!
+4 WRITE !,"ATTENTION: This option should ONLY be run if you have had",!,"a special request from IHS to re-send a large amount of previously",!,"exported data."
+5 WRITE !,"You should use the GEN and REDO options for all regularly scheduled exports.",!!
+6 SET T="INTRO"
FOR J=1:1
SET X=$TEXT(@T+J)
SET X=$PIECE(X,";;",2)
IF X="END"
QUIT
WRITE !,X
+7 KILL J,X,T
+8 ;
CHKSITE ; CHECK SITE FILE
+1 IF '$DATA(^AMHSITE(DUZ(2),0))
WRITE !!,"*** Site file has not been setup! ***"
SET AMH("QFLG")=1
QUIT
+2 IF '$DATA(^AMHSITE(DUZ(2)))
WRITE !!,"*** RUN LOCATION not in SITE file!"
SET AMH("QFLG")=2
QUIT
+3 IF $DATA(^XTMP("AMHEXRL",$JOB))
WRITE !!,"xtmp nodes around from previous run......"
DO XIT
QUIT
+4 WRITE !,"A file will be created and will be placed in the public directory where",!,"all other exports are placed. It will be called AMHX"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_$$NLOG,!
+5 IF $DATA(^BHSXDATA)
WRITE !!,$CHAR(7),$CHAR(7),"BHSXDATA GLOBAL EXISTS FROM A PREVIOUS RUN - CANNOT CONTINUE"
DO XIT
QUIT
GETDATES ;
+1 WRITE !,"Please enter the date range for which the records should be generated.",!
BD ;
+1 SET DIR(0)="D^::EP"
SET DIR("A")="Enter Beginning Date"
SET DIR("?")="Enter the beginning date."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 SET AMHBD=Y
ED ;
+1 SET DIR(0)="DA^::EP"
SET DIR("A")="Enter Ending Date: "
DO ^DIR
KILL DIR,DA
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF Y<AMHBD
WRITE !,"Ending date must be greater than or equal to beginning date!"
GOTO ED
+4 SET AMHED=Y
+5 SET X1=AMHBD
SET X2=-1
DO C^%DTC
SET AMHSD=X
+6 SET AMHERR=0
+7 WRITE !!,"Log entry ",$$NLOG," will be created and records generated for visit",!,"date range ",$$FMTE^XLFDT(AMHBD)," to ",$$FMTE^XLFDT(AMHED),".",!
CONT ;continue or not
+1 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
WRITE !!,"Goodbye"
DO XIT
QUIT
+3 IF 'Y
WRITE !!,"Goodbye"
DO XIT
QUIT
+4 SET AMHRUN="NEW"
SET AMHERR=0
+5 DO HOME^%ZIS
SET AMHBS=$SELECT('$DATA(ZTQUEUED):IOBS,1:"")
+6 ;generate new log entry
DO GENLOG
+7 IF $GET(AMHERR)
DO XIT
QUIT
+8 DO QUEUE
+9 IF $GET(AMHERR)
WRITE !!,"Goodbye, no processing will occur.",!
DO XIT
QUIT
+10 IF $DATA(AMHQUE)
DO XIT
QUIT
+11 ;
PROCESS ;EP - process new run
+1 SET AMHCNT=$SELECT('$DATA(ZTQUEUED):"X AMHCNT1 X AMHCNT2",1:"S AMHTOTV=AMHTOTV+1")
SET AMHCNT1="F AMHCNTL=1:1:$L(AMHTOTV)+1 W @AMHBS"
SET AMHCNT2="S AMHTOTV=AMHTOTV+1 W AMHTOTV,"")"""
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Generating transactions. Counting visits. (1)"
+3 KILL ^BHSXDATA
+4 SET AMHSD=AMHSD_".9999"
+5 ;set counters
+6 SET (AMHTOTV,AMHTERR,AMHTOTR,AMHUSED,AMH("ENC"),AMH("COUNT"),AMH("ERROR COUNT"))=0
KILL AMHERRT
V ; Run by visit date
+1 FOR
SET AMHSD=$ORDER(^AMHREC("B",AMHSD))
IF AMHSD=""!((AMHSD\1)>AMHED)
QUIT
DO V1
SF ;
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Generating suicide forms..."
+2 SET AMHCNTR=0
SET AMH("CONTROL DATE")=""
SET AMHSFC=0
+3 SET AMHSD=AMHSD_".9999"
+4 FOR
SET AMHSD=$ORDER(^AMHPSUIC("AD",AMHSD))
IF AMHSD=""!(AMHSD>AMHED)
QUIT
Begin DoDot:1
+5 SET AMHSFIEN=0
FOR
SET AMHSFIEN=$ORDER(^AMHPSUIC("AD",AMHSD,AMHSFIEN))
IF AMHSFIEN'=+AMHSFIEN
QUIT
Begin DoDot:2
+6 IF '$DATA(^AMHPSUIC(AMHSFIEN,0))
KILL ^AMHPSUIC("AD",AMHSD,AMHSFIEN)
QUIT
+7 SET AMHSREC=^AMHPSUIC(AMHSFIEN,0)
+8 SET DFN=$PIECE(AMHSREC,U,4)
+9 SET AMHRIEN=$ORDER(^AMHRECD("B","BH2",0))
+10 IF 'AMHRIEN
QUIT
+11 SET AMHY=0
SET AMHTX=""
FOR
SET AMHY=$ORDER(^AMHRECD(AMHRIEN,11,"B",AMHY))
IF AMHY'=+AMHY
QUIT
Begin DoDot:3
+12 SET X=""
+13 SET AMHZ=$ORDER(^AMHRECD(AMHRIEN,11,"B",AMHY,0))
+14 IF '$DATA(^AMHRECD(AMHRIEN,11,AMHZ,1))
QUIT
+15 XECUTE ^AMHRECD(AMHRIEN,11,AMHZ,1)
+16 SET $PIECE(AMHTX,U,AMHY)=X
End DoDot:3
+17 SET AMH("COUNT")=AMH("COUNT")+1
SET AMHSFC=AMHSFC+1
+18 SET ^XTMP("AMHEXRL",$JOB,"SF",AMHSFIEN)=""
+19 SET ^BHSXDATA(AMH("COUNT"))=AMHTX
End DoDot:2
End DoDot:1
+20 ;no error check
SET DA=AMHLOG
SET DIE="^AMHEXRL("
SET DR=".05///"_AMHTOTR_";.06///"_AMH("ERROR COUNT")_";.07///"_AMH("COUNT")_";.08///P;.12////"_AMHSFC_";.13////"_AMH("ENC")
DO ^DIE
KILL DIE,DA,DR
+21 SET ^AMHEXRL(AMHLOG,11,0)="^9001005.41A^0^0"
+22 SET X=""
SET C=0
FOR
SET X=$ORDER(AMHERRT(X))
IF X=""
QUIT
SET C=C+1
SET ^AMHEXRL(AMHLOG,11,C,0)=X_"^"_AMHERRT(X)
+23 SET DA=AMHLOG
SET DIK="^AMHEXRL("
DO IX1^DIK
KILL DA,DIK
+24 DO WRITEF
+25 DO RESET
+26 DO XIT
+27 QUIT
V1 ;go through each visit on this date
+1 SET AMHR=""
FOR
SET AMHR=$ORDER(^AMHREC("B",AMHSD,AMHR))
IF AMHR'=+AMHR
QUIT
IF $DATA(^AMHREC(AMHR,0))
SET AMHVREC=^(0)
DO PROC
+2 QUIT
PROC ;
GENREC ;generate record
+1 KILL AMHT,AMHV,AMHE
+2 DO KILL^AUPNPAT
+3 XECUTE AMHCNT
+4 SET AMHREC=^AMHREC(AMHR,0)
+5 SET AMHV("R DATE")=+AMHREC\1
+6 SET AMHTOTR=AMHTOTR+1
+7 KILL AMHE,AMHTX
DO RECORD^AMHEYD2
+8 DO CNTBUILD
+9 DO ^XBFMK
+10 QUIT
CNTBUILD ;count and build tx
+1 IF AMHE]""
SET AMH("ERROR COUNT")=AMH("ERROR COUNT")+1
DO ERRLOG
QUIT
+2 SET ^XTMP("AMHEXRL",$JOB,"VISITS",AMHR)=""
+3 SET AMH("COUNT")=AMH("COUNT")+1
+4 SET ^BHSXDATA(AMH("COUNT"))=AMHTX
+5 QUIT
QUEUE ;EP
+1 KILL ZTSK
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want to QUEUE this to run at a later time"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF Y=1
DO QUEUE1
QUIT
+4 IF AMHRUN="NEW"
IF $DATA(DIRUT)
SET AMHERR=1
SET DA=AMHLOG
SET DIK="^AMHEXRL("
WRITE !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",!
DO ^DIK
KILL DIK,DA
+5 IF AMHRUN="REDO"
IF $DATA(DIRUT)
SET AMHERR=1
QUIT
+6 QUIT
QUEUE1 ;
+1 SET ZTRTN="PROCESS^AMHEYREX"
+2 SET ZTIO=""
SET ZTDTH=""
SET ZTDESC="BH EXPORT DATE RANGE"
SET ZTSAVE("AMH*")=""
+3 DO ^%ZTLOAD
+4 WRITE !!,$SELECT($DATA(ZTSK):"Request Queued!!",1:"Request cancelled")
+5 IF '$DATA(ZTSK)
IF AMHRUN="NEW"
SET AMHERR=1
SET DA=AMHLOG
SET DIK="^AMHEXRL("
WRITE !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",!
DO ^DIK
KILL DIK,DA
QUIT
+6 SET AMHQUE=""
+7 SET DIE="^AMHEXRL("
SET DA=AMHLOG
SET DR=".08///Q"
DO ^DIE
KILL DIE,DA,DR
+8 KILL ZTSK
+9 QUIT
WRITEF ;EP - write out flat file
+1 IF '$DATA(^BHSXDATA)
IF '$DATA(ZTQUEUED)
WRITE !!,"No transactions to send in that date range.",!
QUIT
+2 SET XBGL="BHSXDATA"
+3 SET AMHTX="BH0"
+4 SET $PIECE(AMHTX,U,2)=$PIECE($GET(^AUTTSITE(1,1)),U,3)
+5 SET $PIECE(AMHTX,U,3)=$PIECE($GET(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),1)),U,3)
+6 SET $PIECE(AMHTX,U,4)=$PIECE(^DIC(4,$PIECE(^AUTTSITE(1,0),U),0),U)
+7 SET $PIECE(AMHTX,U,5)=$$DATE^AMHUTIL(DT)
+8 SET $PIECE(AMHTX,U,6)=$$DATE^AMHUTIL($PIECE(^AMHEXRL(AMHLOG,0),U,3))
+9 SET $PIECE(AMHTX,U,7)=$$DATE^AMHUTIL($PIECE(^AMHEXRL(AMHLOG,0),U,4))
+10 SET $PIECE(AMHTX,U,8)="R"
+11 SET $PIECE(AMHTX,U,9)=$PIECE(^AMHEXRL(AMHLOG,0),U,7)
+12 SET $PIECE(AMHTX,U,10)=$PIECE(^AMHEXRL(AMHLOG,0),U,13)
+13 SET $PIECE(AMHTX,U,11)=$PIECE(^AMHEXRL(AMHLOG,0),U,12)
+14 SET ^BHSXDATA(0)=AMHTX
+15 SET XBMED="F"
SET XBFN="BHSX"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_AMHLOG
SET XBTLE="SAVE OF BH BACKLOAD RECORDS GENERATED BY -"_$PIECE(^VA(200,DUZ,0),U)
+16 SET XBF=""
SET XBQ="N"
+17 DO ^XBGSAVE
+18 ;check for error
+19 IF XBFLG=-1
SET AMHERR=1
IF '$DATA(ZTQUEUED)
WRITE !,$CHAR(7),$CHAR(7),XBFLG(1)
QUIT
+20 KILL ^BHSXDATA
+21 SET DA=AMHLOG
SET DIE="^AMHEXRL("
SET DR=".08///S;.11////AMHX"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_AMHLOG
DO ^DIE
KILL DA,DIE,DR
+22 KILL XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT
+23 QUIT
GENLOG ;generate new log entry
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Generating New Log entry.."
+2 SET Y=$$NLOG
SET X=""""_Y_""""
SET DIC="^AMHEXRL("
SET DIC(0)="L"
SET DLAYGO=9002014.6
SET DIC("DR")=".02////"_DT_";.03////"_AMHBD_";.04////"_AMHED_";.09///`"_DUZ(2)
+3 DO ^DIC
KILL DIC,DLAYGO,DR
+4 IF Y<0
WRITE !!,$CHAR(7),$CHAR(7),"Error creating log entry."
SET AMHERR=1
QUIT
+5 SET AMHLOG=+Y
+6 QUIT
XIT ;exit, eoj cleanup
+1 DO EOP
+2 DO ^XBFMK
+3 DO EN^XBVK("AMH")
+4 DO KILL^AUPNPAT
+5 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR("A")="End of Job. Press Return."
SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
DATE(D) ;EP ;IHS/CMI/LAB - new date format - format date in YYYYMMDD format
+1 IF $GET(D)=""
QUIT ""
+2 QUIT $EXTRACT(D,1,3)+1700_$EXTRACT(D,4,7)
+3 ;
+4 ;
NLOG() ;get next log
+1 NEW X,L
SET (X,L)=0
FOR
SET X=$ORDER(^AMHEXRL(X))
IF X'=+X
QUIT
SET L=X
+2 QUIT L+1
INTRO ;introductory text
+1 ;;This program will generate Behavioral Health export records for a visit
+2 ;;date range that you enter. Suicide forms entered in the date range
+3 ;;will also be exported. A log entry will be created which will log
+4 ;;the number of visits processed and the number of records
+5 ;;generated.
+6 ;;
+7 ;;END
RESET ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE
+1 IF '$DATA(ZTQUEUED)
WRITE !,"RE-setting export date. (1)"
+2 SET AMHCNTR=0
SET AMHR=""
+3 FOR
SET AMHR=$ORDER(^XTMP("AMHEXRL",$JOB,"VISITS",AMHR))
IF AMHR'=+AMHR
QUIT
DO RESET1
+4 DO PURGESF
+5 KILL ^XTMP("AMHEXRL",$JOB)
+6 QUIT
+7 ;
RESET1 ; kill MHSS xref and set flag if tx 23 or 24 generated
+1 SET DIE="^AMHREC("
SET DA=AMHR
SET DR=".24///"_DT
DO CALLDIE^AMHLEIN
+2 XECUTE AMHCNT
+3 QUIT
+4 ;
PURGESF ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE
+1 SET AMHCNTR=0
SET AMHR=0
+2 FOR
SET AMHR=$ORDER(^XTMP("AMHEXRL",$JOB,"SF",AMHR))
IF AMHR'=+AMHR
QUIT
DO RESETSF
+3 QUIT
RESETSF ; kill MHSS xref and set flag if tx 23 or 24 generated
+1 SET DA=AMHR
SET DIE="^AMHPSUIC("
SET DR=".23////"_DT
DO CALLDIE^AMHLEIN
+2 XECUTE AMHCNT
+3 QUIT
ERRLOG ;
+1 SET AMHERRTX=$ORDER(^AMHERR("B",AMHE,0))
IF AMHERRTX=""
SET AMHERRT("UNKNOWN ERROR")=$GET(AMHERRT("UNKNOWN ERROR"))+1
+2 SET AMHERRTX=$PIECE(^AMHERR(AMHERRTX,0),U,2)
IF AMHERRTX=""
SET AMHERRT("UNKNOWN ERROR")=$GET(AMHERRT("UNKNOWN ERROR"))+1
+3 SET AMHERRT(AMHERRTX)=$GET(AMHERRT(AMHERRTX))+1
+4 QUIT
