APCPSRE ; IHS/TUCSON/LAB - CMI ; [ 12/16/03 8:07 AM ]
;;2.0;IHS PCC DATA EXTRACTION;**6,7**;APR 03, 1998
;
;
;
START ;Begin processing backload
W:$D(IOF) @IOF
W !,$$CTR($$LOC(),80),!
S X="***** PCC DATA TRANSMISSION SPECIAL 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
;
S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S APCPJD=X+1
S APCP("FILENAME")=""
I $P(^AUTTSITE(1,0),U,21)=1 S APCP("FILENAME")="BAPC"_$P(^AUTTSITE(1,1),U,3)_"."_APCPJD
I $P(^AUTTSITE(1,0),U,21)'=1 D
.I ^%ZOSF("OS")["NT" S APCP("FILENAME")="BAPC"_$P(^AUTTSITE(1,1),U,3)_"."_APCPJD Q
.S APCP("FILENAME")="BAPC"_$E($P(^AUTTSITE(1,1),U,3),3,6)_"."_APCPJD
;S APCP("FILENAME")="BAPC"_$P(^AUTTSITE(1,1),U,3)_"."_APCPJD
W !,"A file will be created and will be placed in the public directory where",!,"all other exports are placed. It will be called ",APCP("FILENAME"),!
I $D(^BAPCDATA) W !!,$C(7),$C(7),"BAPCDATA GLOBAL EXISTS FROM A PREVIOUS RUN - CANNOT CONTINUE" D XIT Q
I $D(^XTMP("APCPDR")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^XTMP nodes exist from previous GEN!! Cannot continue." D XIT Q
I $D(^XTMP("APCPREDO")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^XTMP nodes exist from previous REDO!! Cannot continue." D XIT Q
I $D(^XTMP("APCPSRE")) W:'$D(ZTQUEUED) !!,"*** WARNING *** ^XTMP nodes exist from previous DATE RANGE EXPORT!! Cannot continue." D XIT Q
GETDATES ;
W !,"Please enter the visit date range for which the export should be done.",!
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 APCP("RUN BEGIN")=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<APCP("RUN BEGIN") W !,"Ending date must be greater than or equal to beginning date!" G ED
S APCP("RUN END")=Y
S X1=APCP("RUN BEGIN"),X2=-1 D C^%DTC S APCPSD=X
S APCPERR=0
D CHECK
I $G(APCPERR) W !!,"Goodbye",! D XIT Q
W !!,"A Log entry will be created and records generated for visit",!,"date range ",$$FMTE^XLFDT(APCP("RUN BEGIN"))," to ",$$FMTE^XLFDT(APCP("RUN END")),".",!
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 APCPO("RUN")="DATE",APCPERR=0
D HOME^%ZIS S APCPBS=$S('$D(ZTQUEUED):IOBS,1:"")
K APCPS,APCPV,APCPT,APCPE
S APCP("RUN LOCATION")=$P(^AUTTLOC(DUZ(2),0),U,10),APCP("QFLG")=0
S APCDOVRR=1 ; Allow VISIT lookup with 0 'dependent entry count'.
S (APCP("INPT"),APCP("CHA"),APCP("APC"),APCP("ERROR COUNT"),APCP("COUNT"),APCP("STAT"),APCP("DEL NEVER SENT"),APCP("DEMO PAT"),APCP("IN NO PP"))=0
D CHKSITE^APCPDRI
I $G(APCP("QFLG")) W !!,"Exiting.." D XIT Q
D GENLOG ;generate new log entry
I 'APCP("RUN LOG") Q
D QUEUE
I $G(APCPERR) W !!,"Goodbye, no processing will occur.",! D XIT Q
I $D(APCP("QUEUE")) D XIT Q
;
PROCESS ;EP - process new run
S APCPCNT=$S('$D(ZTQUEUED):"X APCPCNT1 X APCPCNT2",1:"S APCPCNTR=APCPCNTR+1"),APCPCNT1="F APCPCNTL=1:1:$L(APCPCNTR)+1 W @APCPBS",APCPCNT2="S APCPCNTR=APCPCNTR+1 W APCPCNTR,"")"""
W:'$D(ZTQUEUED) !,"Generating transactions. Counting visits. (1)"
S APCPSD=APCPSD_".9999"
;set counters
S (APCPCNTR,APCPTERR,APCPTOTR,APCPUSED)=0
D NOW^%DTC S APCP("RUN START")=%,APCP("MAIN TX DATE")=$P(%,".") K %,%H,%I
S DIE="^APCPLOG(",DA=APCP("RUN LOG"),DR=".24///"_APCP("FILENAME")_";.15///R"_";.03////"_APCP("RUN START") D ^DIE K DA,DIE,DR
V ; Run by visit date
F S APCPSD=$O(^AUPNVSIT("B",APCPSD)) Q:APCPSD=""!((APCPSD\1)>APCP("RUN END")) D V1
D ^APCPLOG
D PURGE
D EN^APCPTAPE
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 APCP("V REC")=^(0) D PROC
Q
PROC ;
K APCPT,APCPV,APCPE
D KILL^AUPNPAT
Q:$D(^APCPLOG(APCP("RUN LOG"),21,APCP("V DFN")))
S APCPV("TX GENERATED")=0,APCPV("STAT TX GEN")=0
X APCPCNT
I $P($G(^AUPNVSIT(APCP("V DFN"),11)),U,4)="" S $P(^AUPNVSIT(APCP("V DFN"),11),U,4)=$$UID^AUPNVSIT(APCP("V DFN"))
S APCPV("V REC")=^AUPNVSIT(APCP("V DFN"),0)
S APCPV("V DATE")=+APCPV("V REC")\1
D ^APCPDR2
S:'$D(^APCPLOG(APCP("RUN LOG"),21,0)) ^APCPLOG(APCP("RUN LOG"),21,0)="^9001005.2101PA^^"
S ^APCPLOG(APCP("RUN LOG"),21,APCP("V DFN"),0)=APCP("V DFN")_U_APCPV("TX GENERATED")_U_APCPV("DEP COUNT")_U_APCPV("TYPE")_U_APCPV("TX GENERATED")_U_U_APCPV("STAT TX GEN")
S $P(^APCPLOG(APCP("RUN LOG"),21,0),U,3)=APCP("V DFN"),$P(^(0),U,4)=$P(^(0),U,4)+1
K DIE,DR,DIC
Q
PURGE ; PURGE SET .14 FIELD
W:'$D(ZTQUEUED) !,"Deleting cross-reference entries. (1)"
S APCPCNTR=0,APCPV("V DFN")=0 ;IHS/CMI/LAB patch 2 set to 0
F S APCPV("V DFN")=$O(^XTMP("APCPSRE","MAIN TX",APCPV("V DFN"))) Q:APCPV("V DFN")'=+APCPV("V DFN") D PURGE2
K ^XTMP("APCPSRE")
Q
PURGE2 ;
S DIE="^AUPNVSIT(",DA=APCPV("V DFN"),DR=".14///"_^XTMP("APCPSRE","MAIN TX",APCPV("V DFN")) D ^DIE K DA,DIE,DR
X APCPCNT
Q
;
CHECK ;
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 APCPO("RUN")="NEW",$D(DIRUT) S APCPERR=1 S DA=APCPLOG,DIK="^APCPLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA
I APCPO("RUN")="REDO",$D(DIRUT) S APCPERR=1 Q
Q
QUEUE1 ;
S ZTRTN="PROCESS^APCPSRE"
S ZTIO="",ZTDTH="",ZTDESC="DATA TRANS BACKLOAD" S ZTSAVE("APCP*")=""
D ^%ZTLOAD
W !!,$S($D(ZTSK):"Request Queued!!",1:"Request cancelled")
I '$D(ZTSK),APCPO("RUN")="NEW" S APCPERR=1 S DA=APCP("RUN LOG"),DIK="^APCPLOG(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA Q
S APCP("QUEUE")=""
S DIE="^APCPLOG(",DA=APCP("RUN LOG"),DR=".15///Q" D ^DIE K DIE,DA,DR
K ZTSK
Q
GENLOG ; GENERATE NEW LOG ENTRY
W:'$D(ZTQUEUED) !,"Generating New Log entry.."
S Y=APCP("RUN BEGIN") X ^DD("DD") S X=""""_Y_"""",DIC="^APCPLOG(",DIC(0)="L",DLAYGO=9001005,DIC("DR")=".02////"_APCP("RUN END")_";.09///`"_DUZ(2)_";.27///1"
D ^DIC K DIC,DLAYGO,DR
I Y<0 W !!,"Error generating log entry" D XIT Q
S APCP("RUN LOG")=+Y
K ^BAPCDATA ;KILLS OKAY PER CMB STANDARDS FOR TRANSMITTING DATA TO DATA CENTER, THESE ARE OFFICIAL SCRATCH GLOBALS
W "Log entry is ",APCP("RUN LOG")
Q
XIT ;exit, eoj cleanup
D EOP
D ^XBFMK
D EN^XBVK("APCP")
D KILL^AUPNPAT
K APCDOVRR
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)
;
;
INTRO ;introductory text
;;This program will generate statistical 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
APCPSRE ; IHS/TUCSON/LAB - CMI ; [ 12/16/03 8:07 AM ]
+1 ;;2.0;IHS PCC DATA EXTRACTION;**6,7**;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 SPECIAL 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 SET X2=$EXTRACT(DT,1,3)_"0101"
SET X1=DT
DO ^%DTC
SET APCPJD=X+1
+10 SET APCP("FILENAME")=""
+11 IF $PIECE(^AUTTSITE(1,0),U,21)=1
SET APCP("FILENAME")="BAPC"_$PIECE(^AUTTSITE(1,1),U,3)_"."_APCPJD
+12 IF $PIECE(^AUTTSITE(1,0),U,21)'=1
Begin DoDot:1
+13 IF ^%ZOSF("OS")["NT"
SET APCP("FILENAME")="BAPC"_$PIECE(^AUTTSITE(1,1),U,3)_"."_APCPJD
QUIT
+14 SET APCP("FILENAME")="BAPC"_$EXTRACT($PIECE(^AUTTSITE(1,1),U,3),3,6)_"."_APCPJD
End DoDot:1
+15 ;S APCP("FILENAME")="BAPC"_$P(^AUTTSITE(1,1),U,3)_"."_APCPJD
+16 WRITE !,"A file will be created and will be placed in the public directory where",!,"all other exports are placed. It will be called ",APCP("FILENAME"),!
+17 IF $DATA(^BAPCDATA)
WRITE !!,$CHAR(7),$CHAR(7),"BAPCDATA GLOBAL EXISTS FROM A PREVIOUS RUN - CANNOT CONTINUE"
DO XIT
QUIT
+18 IF $DATA(^XTMP("APCPDR"))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** WARNING *** ^XTMP nodes exist from previous GEN!! Cannot continue."
DO XIT
QUIT
+19 IF $DATA(^XTMP("APCPREDO"))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** WARNING *** ^XTMP nodes exist from previous REDO!! Cannot continue."
DO XIT
QUIT
+20 IF $DATA(^XTMP("APCPSRE"))
IF '$DATA(ZTQUEUED)
WRITE !!,"*** WARNING *** ^XTMP nodes exist from previous DATE RANGE EXPORT!! Cannot continue."
DO XIT
QUIT
GETDATES ;
+1 WRITE !,"Please enter the visit date range for which the export should be done.",!
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 APCP("RUN BEGIN")=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<APCP("RUN BEGIN")
WRITE !,"Ending date must be greater than or equal to beginning date!"
GOTO ED
+4 SET APCP("RUN END")=Y
+5 SET X1=APCP("RUN BEGIN")
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 !!,"A Log entry will be created and records generated for visit",!,"date range ",$$FMTE^XLFDT(APCP("RUN BEGIN"))," to ",$$FMTE^XLFDT(APCP("RUN END")),".",!
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 APCPO("RUN")="DATE"
SET APCPERR=0
+5 DO HOME^%ZIS
SET APCPBS=$SELECT('$DATA(ZTQUEUED):IOBS,1:"")
+6 KILL APCPS,APCPV,APCPT,APCPE
+7 SET APCP("RUN LOCATION")=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
SET APCP("QFLG")=0
+8 ; Allow VISIT lookup with 0 'dependent entry count'.
SET APCDOVRR=1
+9 SET (APCP("INPT"),APCP("CHA"),APCP("APC"),APCP("ERROR COUNT"),APCP("COUNT"),APCP("STAT"),APCP("DEL NEVER SENT"),APCP("DEMO PAT"),APCP("IN NO PP"))=0
+10 DO CHKSITE^APCPDRI
+11 IF $GET(APCP("QFLG"))
WRITE !!,"Exiting.."
DO XIT
QUIT
+12 ;generate new log entry
DO GENLOG
+13 IF 'APCP("RUN LOG")
QUIT
+14 DO QUEUE
+15 IF $GET(APCPERR)
WRITE !!,"Goodbye, no processing will occur.",!
DO XIT
QUIT
+16 IF $DATA(APCP("QUEUE"))
DO XIT
QUIT
+17 ;
PROCESS ;EP - process new run
+1 SET APCPCNT=$SELECT('$DATA(ZTQUEUED):"X APCPCNT1 X APCPCNT2",1:"S APCPCNTR=APCPCNTR+1")
SET APCPCNT1="F APCPCNTL=1:1:$L(APCPCNTR)+1 W @APCPBS"
SET APCPCNT2="S APCPCNTR=APCPCNTR+1 W APCPCNTR,"")"""
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Generating transactions. Counting visits. (1)"
+3 SET APCPSD=APCPSD_".9999"
+4 ;set counters
+5 SET (APCPCNTR,APCPTERR,APCPTOTR,APCPUSED)=0
+6 DO NOW^%DTC
SET APCP("RUN START")=%
SET APCP("MAIN TX DATE")=$PIECE(%,".")
KILL %,%H,%I
+7 SET DIE="^APCPLOG("
SET DA=APCP("RUN LOG")
SET DR=".24///"_APCP("FILENAME")_";.15///R"_";.03////"_APCP("RUN START")
DO ^DIE
KILL DA,DIE,DR
V ; Run by visit date
+1 FOR
SET APCPSD=$ORDER(^AUPNVSIT("B",APCPSD))
IF APCPSD=""!((APCPSD\1)>APCP("RUN END"))
QUIT
DO V1
+2 DO ^APCPLOG
+3 DO PURGE
+4 DO EN^APCPTAPE
+5 DO XIT
+6 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 APCP("V REC")=^(0)
DO PROC
+2 QUIT
PROC ;
+1 KILL APCPT,APCPV,APCPE
+2 DO KILL^AUPNPAT
+3 IF $DATA(^APCPLOG(APCP("RUN LOG"),21,APCP("V DFN")))
QUIT
+4 SET APCPV("TX GENERATED")=0
SET APCPV("STAT TX GEN")=0
+5 XECUTE APCPCNT
+6 IF $PIECE($GET(^AUPNVSIT(APCP("V DFN"),11)),U,4)=""
SET $PIECE(^AUPNVSIT(APCP("V DFN"),11),U,4)=$$UID^AUPNVSIT(APCP("V DFN"))
+7 SET APCPV("V REC")=^AUPNVSIT(APCP("V DFN"),0)
+8 SET APCPV("V DATE")=+APCPV("V REC")\1
+9 DO ^APCPDR2
+10 IF '$DATA(^APCPLOG(APCP("RUN LOG"),21,0))
SET ^APCPLOG(APCP("RUN LOG"),21,0)="^9001005.2101PA^^"
+11 SET ^APCPLOG(APCP("RUN LOG"),21,APCP("V DFN"),0)=APCP("V DFN")_U_APCPV("TX GENERATED")_U_APCPV("DEP COUNT")_U_APCPV("TYPE")_U_APCPV("TX GENERATED")_U_U_APCPV("STAT TX GEN")
+12 SET $PIECE(^APCPLOG(APCP("RUN LOG"),21,0),U,3)=APCP("V DFN")
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+13 KILL DIE,DR,DIC
+14 QUIT
PURGE ; PURGE SET .14 FIELD
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Deleting cross-reference entries. (1)"
+2 ;IHS/CMI/LAB patch 2 set to 0
SET APCPCNTR=0
SET APCPV("V DFN")=0
+3 FOR
SET APCPV("V DFN")=$ORDER(^XTMP("APCPSRE","MAIN TX",APCPV("V DFN")))
IF APCPV("V DFN")'=+APCPV("V DFN")
QUIT
DO PURGE2
+4 KILL ^XTMP("APCPSRE")
+5 QUIT
PURGE2 ;
+1 SET DIE="^AUPNVSIT("
SET DA=APCPV("V DFN")
SET DR=".14///"_^XTMP("APCPSRE","MAIN TX",APCPV("V DFN"))
DO ^DIE
KILL DA,DIE,DR
+2 XECUTE APCPCNT
+3 QUIT
+4 ;
CHECK ;
+1 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 APCPO("RUN")="NEW"
IF $DATA(DIRUT)
SET APCPERR=1
SET DA=APCPLOG
SET DIK="^APCPLOG("
WRITE !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",!
DO ^DIK
KILL DIK,DA
+5 IF APCPO("RUN")="REDO"
IF $DATA(DIRUT)
SET APCPERR=1
QUIT
+6 QUIT
QUEUE1 ;
+1 SET ZTRTN="PROCESS^APCPSRE"
+2 SET ZTIO=""
SET ZTDTH=""
SET ZTDESC="DATA TRANS BACKLOAD"
SET ZTSAVE("APCP*")=""
+3 DO ^%ZTLOAD
+4 WRITE !!,$SELECT($DATA(ZTSK):"Request Queued!!",1:"Request cancelled")
+5 IF '$DATA(ZTSK)
IF APCPO("RUN")="NEW"
SET APCPERR=1
SET DA=APCP("RUN LOG")
SET DIK="^APCPLOG("
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 APCP("QUEUE")=""
+7 SET DIE="^APCPLOG("
SET DA=APCP("RUN LOG")
SET DR=".15///Q"
DO ^DIE
KILL DIE,DA,DR
+8 KILL ZTSK
+9 QUIT
GENLOG ; GENERATE NEW LOG ENTRY
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Generating New Log entry.."
+2 SET Y=APCP("RUN BEGIN")
XECUTE ^DD("DD")
SET X=""""_Y_""""
SET DIC="^APCPLOG("
SET DIC(0)="L"
SET DLAYGO=9001005
SET DIC("DR")=".02////"_APCP("RUN END")_";.09///`"_DUZ(2)_";.27///1"
+3 DO ^DIC
KILL DIC,DLAYGO,DR
+4 IF Y<0
WRITE !!,"Error generating log entry"
DO XIT
QUIT
+5 SET APCP("RUN LOG")=+Y
+6 ;KILLS OKAY PER CMB STANDARDS FOR TRANSMITTING DATA TO DATA CENTER, THESE ARE OFFICIAL SCRATCH GLOBALS
KILL ^BAPCDATA
+7 WRITE "Log entry is ",APCP("RUN LOG")
+8 QUIT
XIT ;exit, eoj cleanup
+1 DO EOP
+2 DO ^XBFMK
+3 DO EN^XBVK("APCP")
+4 DO KILL^AUPNPAT
+5 KILL APCDOVRR
+6 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 ;
INTRO ;introductory text
+1 ;;This program will generate statistical 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
