APCPREX ; IHS/TUCSON/LAB - CMI ; [ 08/18/2003 7:44 AM ]
;;2.0;IHS PCC DATA EXTRACTION;**3,6**;APR 03, 1998
;
;
;
START ;Begin processing backload
W:$D(IOF) @IOF
W !,$$CTR($$LOC(),80),!
S X="***** PCC DATA TRANSMISSION 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 ORYX or NPIRS 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
;
W !,"A file will be created and will be placed in the public directory where",!,"all other exports are placed. It will be called OX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_$$NLOG,!
I $D(^APCPDATA) W !!,$C(7),$C(7),"APCPDATA GLOBAL EXISTS FROM A PREVIOUS RUN - CANNOT CONTINUE" D XIT Q
GETDATES ;
W !,"Please enter the date range for which the statistical (ORYX) records",!,"should be generated.",!
BD ;
S DIR(0)="D^::EP",DIR("A")="Enter Beginning Visit Date",DIR("?")="Enter the beginning visit date." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
S APCPBD=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<APCPBD W !,"Ending date must be greater than or equal to beginning date!" G ED
S APCPED=Y
S X1=APCPBD,X2=-1 D C^%DTC S APCPSD=X
S APCPERR=0
D CHECK
I $G(APCPERR) W !!,"Goodbye",! D XIT Q
W !!,"Log entry ",$$NLOG," will be created and records generated for visit",!,"date range ",$$FMTE^XLFDT(APCPBD)," to ",$$FMTE^XLFDT(APCPED),".",!
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 APCPRUN="NEW",APCPERR=0
D HOME^%ZIS S APCPBS=$S('$D(ZTQUEUED):IOBS,1:"")
D GENLOG ;generate new log entry
I $G(APCPERR) D XIT Q
D QUEUE
I $G(APCPERR) W !!,"Goodbye, no processing will occur.",! D XIT Q
I $D(APCPQUE) D XIT Q
;
PROCESS ;EP - process new run
S APCPCNT=$S('$D(ZTQUEUED):"X APCPCNT1 X APCPCNT2",1:"S APCPTOTV=APCPTOTV+1"),APCPCNT1="F APCPCNTL=1:1:$L(APCPTOTV)+1 W @APCPBS",APCPCNT2="S APCPTOTV=APCPTOTV+1 W APCPTOTV,"")"""
W:'$D(ZTQUEUED) !,"Generating transactions. Counting visits. (1)"
K ^APCPDATA
S APCPSD=APCPSD_".9999"
;set counters
S (APCPTOTV,APCPTERR,APCPTOTR,APCPUSED)=0
V ; Run by visit date
F S APCPSD=$O(^AUPNVSIT("B",APCPSD)) Q:APCPSD=""!((APCPSD\1)>APCPED) D V1
S DA=APCPLOG,DIE="^APCPREX(",DR=".05///"_APCPTOTV_";.06///"_APCPUSED_";.07///"_APCPTOTR_";.08///P" D ^DIE K DIE,DA,DR ;no error check
S ^APCPREX(APCPLOG,11,0)="^9001005.41A^0^0"
S X="",C=0 F S X=$O(APCPERRT(X)) Q:X="" S C=C+1,^APCPREX(APCPLOG,11,C,0)=X_"^"_APCPERRT(X)
S DA=APCPLOG,DIK="^APCPREX(" D IX1^DIK K DA,DIK
D WRITEF
D XIT
Q
V1 ;go through each visit on this date
S APCP("V DFN")="" F S APCP("V DFN")=$O(^AUPNVSIT("B",APCPSD,APCP("V DFN"))) Q:APCP("V DFN")'=+APCP("V DFN") I $D(^AUPNVSIT(APCP("V DFN"),0)) S APCPVREC=^(0) D PROC
Q
PROC ;
X APCPCNT
I '$P(APCPVREC,U,9) S APCPERRT("ZERO DEP ENTRIES")=$G(APCPERRT("ZERO DEP ENTRIES"))+1 Q ;no dependent entries
I $P(APCPVREC,U,11) S APCPERRT("DELETED VISIT")=$G(APCPERRT("DELETED VISIT"))+1 Q
I $P(APCPVREC,U,23)=.5 Q ;MFI CREATED VISIT
S APCPV("SRV CAT")=$P(APCPVREC,U,7),APCPV("TYPE")=$P(APCPVREC,U,3)
S DFN=$P(APCPVREC,U,5)
I 'DFN S APCPERRT("NO PATIENT")=$G(APCPERRT("NO PATIENT"))+1 Q
I $P(^DPT(DFN,0),U)["DEMO,PATIENT" S APCPERRT("DEMO PATIENT")=$G(APCPERRT("DEMO PATIENT"))+1 Q
I '$D(^AUPNVPOV("AD",APCP("V DFN"))),"EI"'[APCPV("SRV CAT") S APCPERRT("NO POV")=$G(APCPERRT("NO POV"))+1 Q
I $$PRIMPROV^APCLV(APCP("V DFN"),"I")="","EI"'[APCPV("SRV CAT") S APCPERRT("NO PRIM PROV")=$G(APCPERRT("NO PRIM PROV"))+1 Q ;no primary provider
I APCPV("SRV CAT")="H","CVO"'[APCPV("TYPE") D Q:'Y
.S Y=0 S Z=$O(^AUPNVINP("AD",APCP("V DFN"),0))
.I 'Z S APCPERRT("NO V HOSP")=$G(APCPERRT("NO V HOSP"))+1 Q
.I $P($G(^AUPNVINP(Z,0)),U,15) S APCPERRT("HOSP VISIT NOT CODED")=$G(APCPERRT("HOSP VISIT NOT CODED"))+1 Q
.S Y=1
.Q
GENREC ;generate record
D GENREC^APCPREX2
Q
CHECK ;
Q
RERUN ;EP - rerun old log entry
W:$D(IOF) @IOF
W !!,"Rerun DATA TRANSMISSION Backload Visit Set",!
;GET LOG
S DIC="^APCPREX(",DIC(0)="AEMQ" D ^DIC
K DIC,DA,DD,DO,D0
I Y=-1 D XIT Q
S APCPLOG=+Y
S APCPBD=$P(^APCPREX(APCPLOG,0),U,3),APCPED=$P(^(0),U,4),APCPSD=$$FMADD^XLFDT(APCPBD,-1),APCPRUN="REDO"
S APCP0=^APCPREX(APCPLOG,0)
W !!,"Log entry ",APCPLOG," will be reprocessed. Visits in the date range ",!,$$FMTE^XLFDT(APCPBD)," to ",$$FMTE^XLFDT(APCPED)," will be processed.",!
W !,"The output file created will be called OX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_APCPLOG
W !,"The last time a total of ",$P(APCP0,U,5)," visits were processed, of which, ",!,$P(APCP0,U,6)," generated statistical records.",!!
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
D QUEUE
I $G(APCPERR) W !!,"Goodbye, no processing will occur.",! D XIT Q
I $D(APCPQUE) D XIT Q
;
RERUN1 ;
;reset log entry
F X=5,6,7 S $P(^APCPREX(APCPLOG,0),U,X)=""
K ^APCPREX(APCPLOG,11) ;kill error multiple
S DA=APCPLOG,DIE="^APCPREX(",DR=".02///"_DT D ^DIE K DIE,DR,DA
S APCPRUN="REDO",APCPERR=0
D HOME^%ZIS S APCPBS=$S('$D(ZTQUEUED):IOBS,1:"")
G PROCESS
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 APCPRUN="NEW",$D(DIRUT) S APCPERR=1 S DA=APCPLOG,DIK="^APCPREX(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA
I APCPRUN="REDO",$D(DIRUT) S APCPERR=1 Q
Q
QUEUE1 ;
S ZTRTN=$S(APCPRUN="NEW":"PROCESS^APCPREX",1:"RERUN1^APCPREX")
S ZTIO="",ZTDTH="",ZTDESC="ORYX BACKLOAD" S ZTSAVE("APCP*")=""
D ^%ZTLOAD
W !!,$S($D(ZTSK):"Request Queued!!",1:"Request cancelled")
I '$D(ZTSK),APCPRUN="NEW" S APCPERR=1 S DA=APCPLOG,DIK="^APCPREX(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA Q
S APCPQUE=""
S DIE="^APCPREX(",DA=APCPLOG,DR=".15///Q" D ^DIE K DIE,DA,DR
K ZTSK
Q
WRITEF ;EP - write out flat file
I '$D(^APCPDATA)!(APCPTOTR=0) W:'$D(ZTQUEUED) !!,"No transactions to send in that date range.",! Q
S XBGL="APCPDATA"
S ^APCPDATA(0)=$P(^AUTTLOC(DUZ(2),0),U,10)_"^"_$P(^DIC(4,DUZ(2),0),U)_"^"_$$DATE($E(DT,1,7))_"^"_$$DATE(APCPBD)_"^"_$$DATE(APCPED)_"^^"_APCPTOTR_"^^" ;IHS/CMI/LAB - new date format
S XBMED="F",XBFN="OX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_APCPLOG,XBTLE="SAVE OF SDB BACKLOAD RECORDS GENERATED BY -"_$P(^VA(200,DUZ,0),U)
S XBF="",XBQ="N"
D ^XBGSAVE
;check for error
I XBFLG=-1 S APCPERR=1 W:'$D(ZTQUEUED) !,$C(7),$C(7),XBFLG(1) Q
K ^APCPDATA
S DA=APCPLOG,DIE="^APCPREX(",DR=".08///S;.11////OX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_APCPLOG 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="^APCPREX(",DIC(0)="L",DLAYGO=9001005.4,DIC("DR")=".02////"_DT_";.03////"_APCPBD_";.04////"_APCPED_";.09///`"_DUZ(2)
D ^DIC K DIC,DLAYGO,DR
I Y<0 W !!,$C(7),$C(7),"Error creating log entry." S APCPERR=1 Q
S APCPLOG=+Y
Q
XIT ;exit, eoj cleanup
D EOP
D ^XBFMK
D EN^XBVK("APCP")
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(^APCPREX(X)) Q:X'=+X S L=X
Q L+1
INTRO ;introductory text
;;This program will generate statistical records (ORYX records) for a visit
;;date range that you enter. A log entry will be created which will log
;;the number of visits processed and the number of statistical records
;;generated.
;;
;;END
APCPREX ; IHS/TUCSON/LAB - CMI ; [ 08/18/2003 7:44 AM ]
+1 ;;2.0;IHS PCC DATA EXTRACTION;**3,6**;APR 03, 1998
+2 ;
+3 ;
+4 ;
START ;Begin processing backload
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC(),80),!
+3 SET X="***** PCC DATA TRANSMISSION 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 ORYX or NPIRS 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 ;
+9 WRITE !,"A file will be created and will be placed in the public directory where",!,"all other exports are placed. It will be called OX"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_$$NLOG,!
+10 IF $DATA(^APCPDATA)
WRITE !!,$CHAR(7),$CHAR(7),"APCPDATA GLOBAL EXISTS FROM A PREVIOUS RUN - CANNOT CONTINUE"
DO XIT
QUIT
GETDATES ;
+1 WRITE !,"Please enter the date range for which the statistical (ORYX) records",!,"should be generated.",!
BD ;
+1 SET DIR(0)="D^::EP"
SET DIR("A")="Enter Beginning Visit Date"
SET DIR("?")="Enter the beginning visit date."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 SET APCPBD=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<APCPBD
WRITE !,"Ending date must be greater than or equal to beginning date!"
GOTO ED
+4 SET APCPED=Y
+5 SET X1=APCPBD
SET X2=-1
DO C^%DTC
SET APCPSD=X
+6 SET APCPERR=0
+7 DO CHECK
+8 IF $GET(APCPERR)
WRITE !!,"Goodbye",!
DO XIT
QUIT
+9 WRITE !!,"Log entry ",$$NLOG," will be created and records generated for visit",!,"date range ",$$FMTE^XLFDT(APCPBD)," to ",$$FMTE^XLFDT(APCPED),".",!
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 APCPRUN="NEW"
SET APCPERR=0
+5 DO HOME^%ZIS
SET APCPBS=$SELECT('$DATA(ZTQUEUED):IOBS,1:"")
+6 ;generate new log entry
DO GENLOG
+7 IF $GET(APCPERR)
DO XIT
QUIT
+8 DO QUEUE
+9 IF $GET(APCPERR)
WRITE !!,"Goodbye, no processing will occur.",!
DO XIT
QUIT
+10 IF $DATA(APCPQUE)
DO XIT
QUIT
+11 ;
PROCESS ;EP - process new run
+1 SET APCPCNT=$SELECT('$DATA(ZTQUEUED):"X APCPCNT1 X APCPCNT2",1:"S APCPTOTV=APCPTOTV+1")
SET APCPCNT1="F APCPCNTL=1:1:$L(APCPTOTV)+1 W @APCPBS"
SET APCPCNT2="S APCPTOTV=APCPTOTV+1 W APCPTOTV,"")"""
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Generating transactions. Counting visits. (1)"
+3 KILL ^APCPDATA
+4 SET APCPSD=APCPSD_".9999"
+5 ;set counters
+6 SET (APCPTOTV,APCPTERR,APCPTOTR,APCPUSED)=0
V ; Run by visit date
+1 FOR
SET APCPSD=$ORDER(^AUPNVSIT("B",APCPSD))
IF APCPSD=""!((APCPSD\1)>APCPED)
QUIT
DO V1
+2 ;no error check
SET DA=APCPLOG
SET DIE="^APCPREX("
SET DR=".05///"_APCPTOTV_";.06///"_APCPUSED_";.07///"_APCPTOTR_";.08///P"
DO ^DIE
KILL DIE,DA,DR
+3 SET ^APCPREX(APCPLOG,11,0)="^9001005.41A^0^0"
+4 SET X=""
SET C=0
FOR
SET X=$ORDER(APCPERRT(X))
IF X=""
QUIT
SET C=C+1
SET ^APCPREX(APCPLOG,11,C,0)=X_"^"_APCPERRT(X)
+5 SET DA=APCPLOG
SET DIK="^APCPREX("
DO IX1^DIK
KILL DA,DIK
+6 DO WRITEF
+7 DO XIT
+8 QUIT
V1 ;go through each visit on this date
+1 SET APCP("V DFN")=""
FOR
SET APCP("V DFN")=$ORDER(^AUPNVSIT("B",APCPSD,APCP("V DFN")))
IF APCP("V DFN")'=+APCP("V DFN")
QUIT
IF $DATA(^AUPNVSIT(APCP("V DFN"),0))
SET APCPVREC=^(0)
DO PROC
+2 QUIT
PROC ;
+1 XECUTE APCPCNT
+2 ;no dependent entries
IF '$PIECE(APCPVREC,U,9)
SET APCPERRT("ZERO DEP ENTRIES")=$GET(APCPERRT("ZERO DEP ENTRIES"))+1
QUIT
+3 IF $PIECE(APCPVREC,U,11)
SET APCPERRT("DELETED VISIT")=$GET(APCPERRT("DELETED VISIT"))+1
QUIT
+4 ;MFI CREATED VISIT
IF $PIECE(APCPVREC,U,23)=.5
QUIT
+5 SET APCPV("SRV CAT")=$PIECE(APCPVREC,U,7)
SET APCPV("TYPE")=$PIECE(APCPVREC,U,3)
+6 SET DFN=$PIECE(APCPVREC,U,5)
+7 IF 'DFN
SET APCPERRT("NO PATIENT")=$GET(APCPERRT("NO PATIENT"))+1
QUIT
+8 IF $PIECE(^DPT(DFN,0),U)["DEMO,PATIENT"
SET APCPERRT("DEMO PATIENT")=$GET(APCPERRT("DEMO PATIENT"))+1
QUIT
+9 IF '$DATA(^AUPNVPOV("AD",APCP("V DFN")))
IF "EI"'[APCPV("SRV CAT")
SET APCPERRT("NO POV")=$GET(APCPERRT("NO POV"))+1
QUIT
+10 ;no primary provider
IF $$PRIMPROV^APCLV(APCP("V DFN"),"I")=""
IF "EI"'[APCPV("SRV CAT")
SET APCPERRT("NO PRIM PROV")=$GET(APCPERRT("NO PRIM PROV"))+1
QUIT
+11 IF APCPV("SRV CAT")="H"
IF "CVO"'[APCPV("TYPE")
Begin DoDot:1
+12 SET Y=0
SET Z=$ORDER(^AUPNVINP("AD",APCP("V DFN"),0))
+13 IF 'Z
SET APCPERRT("NO V HOSP")=$GET(APCPERRT("NO V HOSP"))+1
QUIT
+14 IF $PIECE($GET(^AUPNVINP(Z,0)),U,15)
SET APCPERRT("HOSP VISIT NOT CODED")=$GET(APCPERRT("HOSP VISIT NOT CODED"))+1
QUIT
+15 SET Y=1
+16 QUIT
End DoDot:1
IF 'Y
QUIT
GENREC ;generate record
+1 DO GENREC^APCPREX2
+2 QUIT
CHECK ;
+1 QUIT
RERUN ;EP - rerun old log entry
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,"Rerun DATA TRANSMISSION Backload Visit Set",!
+3 ;GET LOG
+4 SET DIC="^APCPREX("
SET DIC(0)="AEMQ"
DO ^DIC
+5 KILL DIC,DA,DD,DO,D0
+6 IF Y=-1
DO XIT
QUIT
+7 SET APCPLOG=+Y
+8 SET APCPBD=$PIECE(^APCPREX(APCPLOG,0),U,3)
SET APCPED=$PIECE(^(0),U,4)
SET APCPSD=$$FMADD^XLFDT(APCPBD,-1)
SET APCPRUN="REDO"
+9 SET APCP0=^APCPREX(APCPLOG,0)
+10 WRITE !!,"Log entry ",APCPLOG," will be reprocessed. Visits in the date range ",!,$$FMTE^XLFDT(APCPBD)," to ",$$FMTE^XLFDT(APCPED)," will be processed.",!
+11 WRITE !,"The output file created will be called OX"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_APCPLOG
+12 WRITE !,"The last time a total of ",$PIECE(APCP0,U,5)," visits were processed, of which, ",!,$PIECE(APCP0,U,6)," generated statistical records.",!!
+13 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+14 IF $DATA(DIRUT)
WRITE !!,"Goodbye"
DO XIT
QUIT
+15 IF 'Y
WRITE !!,"Goodbye"
DO XIT
QUIT
+16 DO QUEUE
+17 IF $GET(APCPERR)
WRITE !!,"Goodbye, no processing will occur.",!
DO XIT
QUIT
+18 IF $DATA(APCPQUE)
DO XIT
QUIT
+19 ;
RERUN1 ;
+1 ;reset log entry
+2 FOR X=5,6,7
SET $PIECE(^APCPREX(APCPLOG,0),U,X)=""
+3 ;kill error multiple
KILL ^APCPREX(APCPLOG,11)
+4 SET DA=APCPLOG
SET DIE="^APCPREX("
SET DR=".02///"_DT
DO ^DIE
KILL DIE,DR,DA
+5 SET APCPRUN="REDO"
SET APCPERR=0
+6 DO HOME^%ZIS
SET APCPBS=$SELECT('$DATA(ZTQUEUED):IOBS,1:"")
+7 GOTO PROCESS
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 APCPRUN="NEW"
IF $DATA(DIRUT)
SET APCPERR=1
SET DA=APCPLOG
SET DIK="^APCPREX("
WRITE !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",!
DO ^DIK
KILL DIK,DA
+5 IF APCPRUN="REDO"
IF $DATA(DIRUT)
SET APCPERR=1
QUIT
+6 QUIT
QUEUE1 ;
+1 SET ZTRTN=$SELECT(APCPRUN="NEW":"PROCESS^APCPREX",1:"RERUN1^APCPREX")
+2 SET ZTIO=""
SET ZTDTH=""
SET ZTDESC="ORYX BACKLOAD"
SET ZTSAVE("APCP*")=""
+3 DO ^%ZTLOAD
+4 WRITE !!,$SELECT($DATA(ZTSK):"Request Queued!!",1:"Request cancelled")
+5 IF '$DATA(ZTSK)
IF APCPRUN="NEW"
SET APCPERR=1
SET DA=APCPLOG
SET DIK="^APCPREX("
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 APCPQUE=""
+7 SET DIE="^APCPREX("
SET DA=APCPLOG
SET DR=".15///Q"
DO ^DIE
KILL DIE,DA,DR
+8 KILL ZTSK
+9 QUIT
WRITEF ;EP - write out flat file
+1 IF '$DATA(^APCPDATA)!(APCPTOTR=0)
IF '$DATA(ZTQUEUED)
WRITE !!,"No transactions to send in that date range.",!
QUIT
+2 SET XBGL="APCPDATA"
+3 ;IHS/CMI/LAB - new date format
SET ^APCPDATA(0)=$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"^"_$PIECE(^DIC(4,DUZ(2),0),U)_"^"_$$DATE($EXTRACT(DT,1,7))_"^"_$$DATE(APCPBD)_"^"_$$DATE(APCPED)_"^^"_APCPTOTR_"^^"
+4 SET XBMED="F"
SET XBFN="OX"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_APCPLOG
SET XBTLE="SAVE OF SDB BACKLOAD RECORDS GENERATED BY -"_$PIECE(^VA(200,DUZ,0),U)
+5 SET XBF=""
SET XBQ="N"
+6 DO ^XBGSAVE
+7 ;check for error
+8 IF XBFLG=-1
SET APCPERR=1
IF '$DATA(ZTQUEUED)
WRITE !,$CHAR(7),$CHAR(7),XBFLG(1)
QUIT
+9 KILL ^APCPDATA
+10 SET DA=APCPLOG
SET DIE="^APCPREX("
SET DR=".08///S;.11////OX"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_APCPLOG
DO ^DIE
KILL DA,DIE,DR
+11 KILL XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT
+12 QUIT
GENLOG ;generate new log entry
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Generating New Log entry.."
+2 SET Y=$$NLOG
SET X=""""_Y_""""
SET DIC="^APCPREX("
SET DIC(0)="L"
SET DLAYGO=9001005.4
SET DIC("DR")=".02////"_DT_";.03////"_APCPBD_";.04////"_APCPED_";.09///`"_DUZ(2)
+3 DO ^DIC
KILL DIC,DLAYGO,DR
+4 IF Y<0
WRITE !!,$CHAR(7),$CHAR(7),"Error creating log entry."
SET APCPERR=1
QUIT
+5 SET APCPLOG=+Y
+6 QUIT
XIT ;exit, eoj cleanup
+1 DO EOP
+2 DO ^XBFMK
+3 DO EN^XBVK("APCP")
+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(^APCPREX(X))
IF X'=+X
QUIT
SET L=X
+2 QUIT L+1
INTRO ;introductory text
+1 ;;This program will generate statistical records (ORYX records) for a visit
+2 ;;date range that you enter. A log entry will be created which will log
+3 ;;the number of visits processed and the number of statistical records
+4 ;;generated.
+5 ;;
+6 ;;END
