APCPREDO ; IHS/TUCSON/LAB - OHPRD-TUCSON/EDE REDO A PREVIOUS RUN AUGUST 14, 1992 ; [ 12/16/03 8:06 AM ]
;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,2,3,6,7**;APR 03, 1998
;IHS/CMI/LAB - xtmp/new stat record
START ;
S APCPO("RUN")="REDO" ; Let ^APCPDRI know this is a 'REDO'
D ^APCPDRI ;
I APCP("QFLG") D EOJ W !!,"Bye",!! Q
D INIT ; Get Log entry to redo
I APCP("QFLG") D EOJ W !!,"Bye",!! Q
D QUEUE^APCPDRI
I APCP("QFLG") D EOJ W !!,"Bye",!! Q
I $D(APCPO("QUEUE")) D EOJ W !!,"Okay your request is queued!",!! Q
;
EN ;EP FROM TASKMAN
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,"")"""
D NOW^%DTC S APCP("RUN START")=%,APCP("MAIN TX DATE")=$P(%,".") K %,%H,%I
S APCP("BT")=$HOROLOG
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
D ^XBFMK S DA=APCP("RUN LOG"),DR=".24///"_APCP("FILENAME")_";.25///1",DIE="^APCPLOG(" D ^DIE D ^XBFMK
D PROCESS ; Generate transactions
I APCP("QFLG") W:'$D(ZTQUEUED) !!,"Abnormal termination! QFLG=",APCP("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D ^APCPRLOG ; Update Log entry
I APCP("QFLG") W:'$D(ZTQUEUED) !!,"Log error! ",APCP("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D:'$D(ZTQUEUED) RUNTIME^APCPEOJ
I APCP("QFLG") W:'$D(ZTQUEUED) !!,"Tape creation error! QFLG=",APCP("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
D:'$D(ZTQUEUED) CHKLOG ; See if Log needs cleaning
D RESETV ; Reset VISITs processed in Log
D TAPE ; Write transactions to tape
I '$D(ZTQUEUED) S DIR(0)="EO",DIR("A")="DONE -- Press RETURN to Continue" K DA D ^DIR K DIR
D EOJ
K APCP
Q
;
PROCESS ;
S ^XTMP("APCPREDO",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"PCC EXPORT REDO" ;IHS/CMI/LAB
W:'$D(ZTQUEUED) !,"Generating transactions. Counting visits. (1)" S APCPCNTR=0
S APCP("V DFN")=0 F S APCP("V DFN")=$O(^APCPLOG(APCP("RUN LOG"),21,APCP("V DFN"))) Q:APCP("V DFN")'=+APCP("V DFN") D PROCESS2 Q:APCP("QFLG")
Q
PROCESS2 ;
K APCPE,APCPV
X APCPCNT
S ^XTMP("APCPREDO","MAIN TX",APCP("V DFN"))="",APCPV("TX GENERATED")=0,APCPV("STAT TX GEN")=0
I '$D(^AUPNVSIT(APCP("V DFN"))) Q
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)
;I $P(APCPV("V REC"),U,11) S APCPV("DEP COUNT")=0,APCPV("TYPE")=$P(APCPV("V REC"),U,3),APCP("DELETED")=$G(APCP("DELETED"))+1 D SETUTIL Q
S APCPV("V DATE")=+APCPV("V REC")\1
S APCP("POSTING DATE")=" "
D ^APCPDR2
SETUTIL S ^XTMP("APCPREDO",APCP("V DFN"))=APCP("V DFN")_U_APCPV("TX GENERATED")_U_APCPV("DEP COUNT")_U_APCPV("TYPE")_U_$S(^XTMP("APCPREDO","MAIN TX",APCP("V DFN"))]"":1,1:0)_U_U_APCPV("STAT TX GEN")
Q
;
TAPE ; COPY TRANSACTIONS TO TAPE
S APCP("DEF DEVICE")=$P(^APCPSITE(1,0),U,2)
I APCP("DEF DEVICE")="" W:'$D(ZTQUEUED) !,"No Default Device in SITE File",!," NOTIFY YOUR SUPERVISOR, I cannot continue until there is a default device ",!," in the Site File",$C(7),$C(7) S APCP("QFLG")=4 Q
I APCP("DEF DEVICE")="F",$P(^APCPSITE(1,0),U,11)'="N" D EN^APCPTAPE I $D(ZTQUEUED),APCP("QFLG") D ABORT
Q:APCP("QFLG")
Q:$D(ZTQUEUED)
Q:$P(^APCPSITE(1,0),U,11)="Y"
S DIR(0)="Y",DIR("A")="Do you want to write the Transactions to an output device",DIR("B")="N" K DA D ^DIR K DIR
Q:$D(DIRUT)
Q:'Y
I Y S APCP("APCPTAPE")="" D EN^APCPTAPE
I APCP("QFLG")=99 S APCP("QFLG")=0
Q
;
;
CHKLOG ; CHECK LOG FILE
S APCP("X")=0 F APCP("I")=APCP("RUN LOG"):-1:1 Q:'$D(^APCPLOG(APCP("I"))) I $O(^APCPLOG(APCP("I"),21,0)) S APCP("X")=APCP("X")+1
I APCP("X")>3 W !!,"-->There are more than three generations of VISITs stored in the LOG file.",!,"-->Time to do a purge."
Q
;
RESETV ; RESET VISIT DATA IN LOG
W:'$D(ZTQUEUED) !,"Resetting VISIT specific data in Log file. (1)" S APCPCNTR=0
S APCP("X")=0 F S APCP("X")=$O(^XTMP("APCPREDO",APCP("X"))) Q:APCP("X")'=+APCP("X") S APCP("Y")=^(APCP("X")),^APCPLOG(APCP("RUN LOG"),21,APCP("X"),0)=APCP("Y") X APCPCNT ;FORGIVE ME LORD
W:'$D(ZTQUEUED) !,"Resetting VISIT TX Flags. (1)" S APCPCNTR=0
S APCP("X")=0 F S APCP("X")=$O(^XTMP("APCPREDO","MAIN TX",APCP("X"))) Q:APCP("X")'=+APCP("X") D
.S DIE="^AUPNVSIT(",DA=APCP("X"),DR=".14///"_$S(^XTMP("APCPREDO","MAIN TX",APCP("X"))]"":^XTMP("APCPREDO","MAIN TX",APCP("X")),1:"@") D ^DIE K DA,DR X APCPCNT
.Q
K ^XTMP("APCPREDO")
Q
;
INIT ;
D INIT^APCPRED1
Q
ABORT ; ABNORMAL TERMINATION
I $D(APCP("RUN LOG")) S APCP("QFLG1")=$O(^APCPERRC("B",APCP("QFLG"),"")),DA=APCP("RUN LOG"),DIE="^APCPLOG(",DR=".15///F;.16////"_APCP("QFLG1")
I $D(ZTQUEUED) D ERRBULL^APCPDRI3,EOJ Q
W !!,"Abnormal termination!! QFLG=",APCP("QFLG")
S DIR(0)="EO",DIR("A")="Press any key to continue" K DA D ^DIR K DIR
Q
;
EOJ ;
D ^APCPEOJ
Q
APCPREDO ; IHS/TUCSON/LAB - OHPRD-TUCSON/EDE REDO A PREVIOUS RUN AUGUST 14, 1992 ; [ 12/16/03 8:06 AM ]
+1 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,2,3,6,7**;APR 03, 1998
+2 ;IHS/CMI/LAB - xtmp/new stat record
START ;
+1 ; Let ^APCPDRI know this is a 'REDO'
SET APCPO("RUN")="REDO"
+2 ;
DO ^APCPDRI
+3 IF APCP("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+4 ; Get Log entry to redo
DO INIT
+5 IF APCP("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+6 DO QUEUE^APCPDRI
+7 IF APCP("QFLG")
DO EOJ
WRITE !!,"Bye",!!
QUIT
+8 IF $DATA(APCPO("QUEUE"))
DO EOJ
WRITE !!,"Okay your request is queued!",!!
QUIT
+9 ;
EN ;EP FROM TASKMAN
+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 DO NOW^%DTC
SET APCP("RUN START")=%
SET APCP("MAIN TX DATE")=$PIECE(%,".")
KILL %,%H,%I
+3 SET APCP("BT")=$HOROLOG
+4 SET X2=$EXTRACT(DT,1,3)_"0101"
SET X1=DT
DO ^%DTC
SET APCPJD=X+1
+5 SET APCP("FILENAME")=""
+6 IF $PIECE(^AUTTSITE(1,0),U,21)=1
SET APCP("FILENAME")="BAPC"_$PIECE(^AUTTSITE(1,1),U,3)_"."_APCPJD
+7 IF $PIECE(^AUTTSITE(1,0),U,21)'=1
Begin DoDot:1
+8 IF ^%ZOSF("OS")["NT"
SET APCP("FILENAME")="BAPC"_$PIECE(^AUTTSITE(1,1),U,3)_"."_APCPJD
QUIT
+9 SET APCP("FILENAME")="BAPC"_$EXTRACT($PIECE(^AUTTSITE(1,1),U,3),3,6)_"."_APCPJD
End DoDot:1
+10 DO ^XBFMK
SET DA=APCP("RUN LOG")
SET DR=".24///"_APCP("FILENAME")_";.25///1"
SET DIE="^APCPLOG("
DO ^DIE
DO ^XBFMK
+11 ; Generate transactions
DO PROCESS
+12 IF APCP("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Abnormal termination! QFLG=",APCP("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+13 ; Update Log entry
DO ^APCPRLOG
+14 IF APCP("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Log error! ",APCP("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+15 IF '$DATA(ZTQUEUED)
DO RUNTIME^APCPEOJ
+16 IF APCP("QFLG")
IF '$DATA(ZTQUEUED)
WRITE !!,"Tape creation error! QFLG=",APCP("QFLG")
IF $DATA(ZTQUEUED)
DO ABORT
DO EOJ
QUIT
+17 ; See if Log needs cleaning
IF '$DATA(ZTQUEUED)
DO CHKLOG
+18 ; Reset VISITs processed in Log
DO RESETV
+19 ; Write transactions to tape
DO TAPE
+20 IF '$DATA(ZTQUEUED)
SET DIR(0)="EO"
SET DIR("A")="DONE -- Press RETURN to Continue"
KILL DA
DO ^DIR
KILL DIR
+21 DO EOJ
+22 KILL APCP
+23 QUIT
+24 ;
PROCESS ;
+1 ;IHS/CMI/LAB
SET ^XTMP("APCPREDO",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"PCC EXPORT REDO"
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Generating transactions. Counting visits. (1)"
SET APCPCNTR=0
+3 SET APCP("V DFN")=0
FOR
SET APCP("V DFN")=$ORDER(^APCPLOG(APCP("RUN LOG"),21,APCP("V DFN")))
IF APCP("V DFN")'=+APCP("V DFN")
QUIT
DO PROCESS2
IF APCP("QFLG")
QUIT
+4 QUIT
PROCESS2 ;
+1 KILL APCPE,APCPV
+2 XECUTE APCPCNT
+3 SET ^XTMP("APCPREDO","MAIN TX",APCP("V DFN"))=""
SET APCPV("TX GENERATED")=0
SET APCPV("STAT TX GEN")=0
+4 IF '$DATA(^AUPNVSIT(APCP("V DFN")))
QUIT
+5 IF $PIECE($GET(^AUPNVSIT(APCP("V DFN"),11)),U,4)=""
SET $PIECE(^AUPNVSIT(APCP("V DFN"),11),U,4)=$$UID^AUPNVSIT(APCP("V DFN"))
+6 SET APCPV("V REC")=^AUPNVSIT(APCP("V DFN"),0)
+7 ;I $P(APCPV("V REC"),U,11) S APCPV("DEP COUNT")=0,APCPV("TYPE")=$P(APCPV("V REC"),U,3),APCP("DELETED")=$G(APCP("DELETED"))+1 D SETUTIL Q
+8 SET APCPV("V DATE")=+APCPV("V REC")\1
+9 SET APCP("POSTING DATE")=" "
+10 DO ^APCPDR2
SETUTIL SET ^XTMP("APCPREDO",APCP("V DFN"))=APCP("V DFN")_U_APCPV("TX GENERATED")_U_APCPV("DEP COUNT")_U_APCPV("TYPE")_U_$SELECT(^XTMP("APCPREDO","MAIN TX",APCP("V DFN"))]"":1,1:0)_U_U_APCPV("STAT TX GEN")
+1 QUIT
+2 ;
TAPE ; COPY TRANSACTIONS TO TAPE
+1 SET APCP("DEF DEVICE")=$PIECE(^APCPSITE(1,0),U,2)
+2 IF APCP("DEF DEVICE")=""
IF '$DATA(ZTQUEUED)
WRITE !,"No Default Device in SITE File",!," NOTIFY YOUR SUPERVISOR, I cannot continue until there is a default device ",!," in the Site File",$CHAR(7),$CHAR(7)
SET APCP("QFLG")=4
QUIT
+3 IF APCP("DEF DEVICE")="F"
IF $PIECE(^APCPSITE(1,0),U,11)'="N"
DO EN^APCPTAPE
IF $DATA(ZTQUEUED)
IF APCP("QFLG")
DO ABORT
+4 IF APCP("QFLG")
QUIT
+5 IF $DATA(ZTQUEUED)
QUIT
+6 IF $PIECE(^APCPSITE(1,0),U,11)="Y"
QUIT
+7 SET DIR(0)="Y"
SET DIR("A")="Do you want to write the Transactions to an output device"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
QUIT
+9 IF 'Y
QUIT
+10 IF Y
SET APCP("APCPTAPE")=""
DO EN^APCPTAPE
+11 IF APCP("QFLG")=99
SET APCP("QFLG")=0
+12 QUIT
+13 ;
+14 ;
CHKLOG ; CHECK LOG FILE
+1 SET APCP("X")=0
FOR APCP("I")=APCP("RUN LOG"):-1:1
IF '$DATA(^APCPLOG(APCP("I")))
QUIT
IF $ORDER(^APCPLOG(APCP("I"),21,0))
SET APCP("X")=APCP("X")+1
+2 IF APCP("X")>3
WRITE !!,"-->There are more than three generations of VISITs stored in the LOG file.",!,"-->Time to do a purge."
+3 QUIT
+4 ;
RESETV ; RESET VISIT DATA IN LOG
+1 IF '$DATA(ZTQUEUED)
WRITE !,"Resetting VISIT specific data in Log file. (1)"
SET APCPCNTR=0
+2 ;FORGIVE ME LORD
SET APCP("X")=0
FOR
SET APCP("X")=$ORDER(^XTMP("APCPREDO",APCP("X")))
IF APCP("X")'=+APCP("X")
QUIT
SET APCP("Y")=^(APCP("X"))
SET ^APCPLOG(APCP("RUN LOG"),21,APCP("X"),0)=APCP("Y")
XECUTE APCPCNT
+3 IF '$DATA(ZTQUEUED)
WRITE !,"Resetting VISIT TX Flags. (1)"
SET APCPCNTR=0
+4 SET APCP("X")=0
FOR
SET APCP("X")=$ORDER(^XTMP("APCPREDO","MAIN TX",APCP("X")))
IF APCP("X")'=+APCP("X")
QUIT
Begin DoDot:1
+5 SET DIE="^AUPNVSIT("
SET DA=APCP("X")
SET DR=".14///"_$SELECT(^XTMP("APCPREDO","MAIN TX",APCP("X"))]"":^XTMP("APCPREDO","MAIN TX",APCP("X")),1:"@")
DO ^DIE
KILL DA,DR
XECUTE APCPCNT
+6 QUIT
End DoDot:1
+7 KILL ^XTMP("APCPREDO")
+8 QUIT
+9 ;
INIT ;
+1 DO INIT^APCPRED1
+2 QUIT
ABORT ; ABNORMAL TERMINATION
+1 IF $DATA(APCP("RUN LOG"))
SET APCP("QFLG1")=$ORDER(^APCPERRC("B",APCP("QFLG"),""))
SET DA=APCP("RUN LOG")
SET DIE="^APCPLOG("
SET DR=".15///F;.16////"_APCP("QFLG1")
+2 IF $DATA(ZTQUEUED)
DO ERRBULL^APCPDRI3
DO EOJ
QUIT
+3 WRITE !!,"Abnormal termination!! QFLG=",APCP("QFLG")
+4 SET DIR(0)="EO"
SET DIR("A")="Press any key to continue"
KILL DA
DO ^DIR
KILL DIR
+5 QUIT
+6 ;
EOJ ;
+1 DO ^APCPEOJ
+2 QUIT
