APCPDR ; IHS/TUCSON/LAB - MAIN DRIVER FOR PCC EXPORT TX GEN AUGUST 14, 1992 ; [ 12/16/03 7:59 AM ]
;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,2,3,6,7**;APR 03, 1998
START ;EP - called from option
I $D(ZTQUEUED) S APCPO("SCHEDULED")=""
S APCPO("RUN")="NEW" ; Let APCPDRI know this is a new run.
D ^APCPDRI ; Do initialization
I $D(APCPO("QUEUE")) D EOJ W !!,"Okay, request queued!!",!! Q
I APCP("QFLG")=99 D EOJ W !!,"Bye",!! Q
I APCP("QFLG") D ABORT Q
DRIVER ;EP called from TSKMN+2
S APCP("BT")=$H
D NOW^%DTC S APCP("RUN START")=%,APCP("MAIN TX DATE")=$P(%,".") K %,%H,%I
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 DIE="^APCPLOG(",DA=APCP("RUN LOG"),DR=".24///"_APCP("FILENAME")_";.15///R"_";.03////"_APCP("RUN START") D ^DIE K DA,DIE,DR
;D ^APCPFIXD
I APCP("QFLG") D ABORT Q
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 PROCESS ; Generate trasactions
I APCP("QFLG") D ABORT Q
D ^APCPLOG ; Update Log
I APCP("QFLG") D ABORT Q
D PURGE ; Purge APCIS xref entries
D RUNTIME^APCPEOJ ; Show run time
D TAPE ; Write transactions to tape
I APCP("QFLG") D ABORT Q
D:'$D(ZTQUEUED) CHKLOG ; See if Log needs cleaning
I '$D(ZTQUEUED) S DIR(0)="EO",DIR("A")="DONE -- Press RETURN to Continue" K DA D ^DIR K DIR
D EOJ
Q
;
PROCESS ;
S ^XTMP("APCPDR",0)=$$FMADD^XLFDT(DT,14)_U_DT_"PCC DATA TRANSMISSION" ;IHS/CMI/LAB - patch 2
W:'$D(ZTQUEUED) !,"Generating transactions. Counting visits. (1)"
S APCPCNTR=0,APCP("CONTROL DATE")=APCP("RUN BEGIN")-1,APCP("POSTING DATE")=" "
F S APCP("CONTROL DATE")=$O(^AUPNVSIT("APCIS",APCP("CONTROL DATE"))) Q:APCP("CONTROL DATE")=""!(APCP("CONTROL DATE")>APCP("RUN END")) D PROCESS2 Q:APCP("QFLG")
Q
PROCESS2 ;
S APCP("V DFN")="" F S APCP("V DFN")=$O(^AUPNVSIT("APCIS",APCP("CONTROL DATE"),APCP("V DFN"))) Q:APCP("V DFN")="" D PROCESS3 Q:APCP("QFLG")
Q
PROCESS3 ;
K APCPT,APCPV,APCPE
D KILL^AUPNPAT
Q:$D(^APCPLOG(APCP("RUN LOG"),21,APCP("V DFN")))
S APCPV("TX GENERATED")=0,^XTMP("APCPDR",APCP("CONTROL DATE"),APCP("V DFN"))="",^XTMP("APCPDR","MAIN TX",APCP("V DFN"))="",APCPV("STAT TX GEN")=0
X APCPCNT
Q:'$D(^AUPNVSIT(APCP("V DFN"),0))
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_$S(^XTMP("APCPDR","MAIN TX",APCP("V DFN"))]"":1,1:0)_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 'APCIS' XREF FOR VISITS JUST DONE
W:'$D(ZTQUEUED) !,"Deleting cross-reference entries. (1)"
S APCPCNTR=0,APCPV("V DATE")=0 ;IHS/CMI/LAB patch 2 set to 0
F S APCPV("V DATE")=$O(^XTMP("APCPDR",APCPV("V DATE"))) Q:APCPV("V DATE")'=+APCPV("V DATE") D PURGE2
K ^XTMP("APCPDR")
Q
PURGE2 ;
S APCP("V DFN")="" F S APCP("V DFN")=$O(^XTMP("APCPDR",APCPV("V DATE"),APCP("V DFN"))) Q:APCP("V DFN")="" D RESET
Q
;
RESET ; kill PCIS xref and set flag if tx 23 or 24 generated
K ^AUPNVSIT("APCIS",APCPV("V DATE"),APCP("V DFN"))
I ^XTMP("APCPDR","MAIN TX",APCP("V DFN"))]"" S DIE="^AUPNVSIT(",DA=APCP("V DFN"),DR=".14///"_^XTMP("APCPDR","MAIN TX",APCP("V DFN")) D ^DIE K DA,DIE,DR
X APCPCNT
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 ERRBULL^APCPDRI3
;D EN^APCPTAPE I $D(ZTQUEUED),APCP("QFLG") D ERRBULL^APCPDRI3
I APCP("DEF DEVICE")="F",$P(^APCPSITE(1,0),U,11)="Y" Q
Q:APCP("QFLG")
Q:$D(ZTQUEUED)
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")>15 W !,"-->There are more than fifteen generations of VISITs stored in the LOG file.",!,"-->Time to do a purge."
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
D EOJ
Q
;
EOJ ; EOJ
D ^APCPEOJ
Q
APCPDR ; IHS/TUCSON/LAB - MAIN DRIVER FOR PCC EXPORT TX GEN AUGUST 14, 1992 ; [ 12/16/03 7:59 AM ]
+1 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;**1,2,3,6,7**;APR 03, 1998
START ;EP - called from option
+1 IF $DATA(ZTQUEUED)
SET APCPO("SCHEDULED")=""
+2 ; Let APCPDRI know this is a new run.
SET APCPO("RUN")="NEW"
+3 ; Do initialization
DO ^APCPDRI
+4 IF $DATA(APCPO("QUEUE"))
DO EOJ
WRITE !!,"Okay, request queued!!",!!
QUIT
+5 IF APCP("QFLG")=99
DO EOJ
WRITE !!,"Bye",!!
QUIT
+6 IF APCP("QFLG")
DO ABORT
QUIT
DRIVER ;EP called from TSKMN+2
+1 SET APCP("BT")=$HOROLOG
+2 DO NOW^%DTC
SET APCP("RUN START")=%
SET APCP("MAIN TX DATE")=$PIECE(%,".")
KILL %,%H,%I
+3 SET X2=$EXTRACT(DT,1,3)_"0101"
SET X1=DT
DO ^%DTC
SET APCPJD=X+1
+4 SET APCP("FILENAME")=""
+5 IF $PIECE(^AUTTSITE(1,0),U,21)=1
SET APCP("FILENAME")="BAPC"_$PIECE(^AUTTSITE(1,1),U,3)_"."_APCPJD
+6 IF $PIECE(^AUTTSITE(1,0),U,21)'=1
Begin DoDot:1
+7 IF ^%ZOSF("OS")["NT"
SET APCP("FILENAME")="BAPC"_$PIECE(^AUTTSITE(1,1),U,3)_"."_APCPJD
QUIT
+8 SET APCP("FILENAME")="BAPC"_$EXTRACT($PIECE(^AUTTSITE(1,1),U,3),3,6)_"."_APCPJD
End DoDot:1
+9 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
+10 ;D ^APCPFIXD
+11 IF APCP("QFLG")
DO ABORT
QUIT
+12 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,"")"""
+13 ; Generate trasactions
DO PROCESS
+14 IF APCP("QFLG")
DO ABORT
QUIT
+15 ; Update Log
DO ^APCPLOG
+16 IF APCP("QFLG")
DO ABORT
QUIT
+17 ; Purge APCIS xref entries
DO PURGE
+18 ; Show run time
DO RUNTIME^APCPEOJ
+19 ; Write transactions to tape
DO TAPE
+20 IF APCP("QFLG")
DO ABORT
QUIT
+21 ; See if Log needs cleaning
IF '$DATA(ZTQUEUED)
DO CHKLOG
+22 IF '$DATA(ZTQUEUED)
SET DIR(0)="EO"
SET DIR("A")="DONE -- Press RETURN to Continue"
KILL DA
DO ^DIR
KILL DIR
+23 DO EOJ
+24 QUIT
+25 ;
PROCESS ;
+1 ;IHS/CMI/LAB - patch 2
SET ^XTMP("APCPDR",0)=$$FMADD^XLFDT(DT,14)_U_DT_"PCC DATA TRANSMISSION"
+2 IF '$DATA(ZTQUEUED)
WRITE !,"Generating transactions. Counting visits. (1)"
+3 SET APCPCNTR=0
SET APCP("CONTROL DATE")=APCP("RUN BEGIN")-1
SET APCP("POSTING DATE")=" "
+4 FOR
SET APCP("CONTROL DATE")=$ORDER(^AUPNVSIT("APCIS",APCP("CONTROL DATE")))
IF APCP("CONTROL DATE")=""!(APCP("CONTROL DATE")>APCP("RUN END"))
QUIT
DO PROCESS2
IF APCP("QFLG")
QUIT
+5 QUIT
PROCESS2 ;
+1 SET APCP("V DFN")=""
FOR
SET APCP("V DFN")=$ORDER(^AUPNVSIT("APCIS",APCP("CONTROL DATE"),APCP("V DFN")))
IF APCP("V DFN")=""
QUIT
DO PROCESS3
IF APCP("QFLG")
QUIT
+2 QUIT
PROCESS3 ;
+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 ^XTMP("APCPDR",APCP("CONTROL DATE"),APCP("V DFN"))=""
SET ^XTMP("APCPDR","MAIN TX",APCP("V DFN"))=""
SET APCPV("STAT TX GEN")=0
+5 XECUTE APCPCNT
+6 IF '$DATA(^AUPNVSIT(APCP("V DFN"),0))
QUIT
+7 IF $PIECE($GET(^AUPNVSIT(APCP("V DFN"),11)),U,4)=""
SET $PIECE(^AUPNVSIT(APCP("V DFN"),11),U,4)=$$UID^AUPNVSIT(APCP("V DFN"))
+8 SET APCPV("V REC")=^AUPNVSIT(APCP("V DFN"),0)
+9 SET APCPV("V DATE")=+APCPV("V REC")\1
+10 DO ^APCPDR2
+11 IF '$DATA(^APCPLOG(APCP("RUN LOG"),21,0))
SET ^APCPLOG(APCP("RUN LOG"),21,0)="^9001005.2101PA^^"
+12 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_$SELECT(^XTMP("APCPDR","MAIN TX",APCP("V DFN"))]"":1,1:0)_U_U_APCPV("STAT TX GEN")
+13 SET $PIECE(^APCPLOG(APCP("RUN LOG"),21,0),U,3)=APCP("V DFN")
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+14 KILL DIE,DR,DIC
+15 QUIT
+16 ;
PURGE ; PURGE 'APCIS' XREF FOR VISITS JUST DONE
+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 DATE")=0
+3 FOR
SET APCPV("V DATE")=$ORDER(^XTMP("APCPDR",APCPV("V DATE")))
IF APCPV("V DATE")'=+APCPV("V DATE")
QUIT
DO PURGE2
+4 KILL ^XTMP("APCPDR")
+5 QUIT
PURGE2 ;
+1 SET APCP("V DFN")=""
FOR
SET APCP("V DFN")=$ORDER(^XTMP("APCPDR",APCPV("V DATE"),APCP("V DFN")))
IF APCP("V DFN")=""
QUIT
DO RESET
+2 QUIT
+3 ;
RESET ; kill PCIS xref and set flag if tx 23 or 24 generated
+1 KILL ^AUPNVSIT("APCIS",APCPV("V DATE"),APCP("V DFN"))
+2 IF ^XTMP("APCPDR","MAIN TX",APCP("V DFN"))]""
SET DIE="^AUPNVSIT("
SET DA=APCP("V DFN")
SET DR=".14///"_^XTMP("APCPDR","MAIN TX",APCP("V DFN"))
DO ^DIE
KILL DA,DIE,DR
+3 XECUTE APCPCNT
+4 QUIT
+5 ;
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 ERRBULL^APCPDRI3
+4 ;D EN^APCPTAPE I $D(ZTQUEUED),APCP("QFLG") D ERRBULL^APCPDRI3
+5 IF APCP("DEF DEVICE")="F"
IF $PIECE(^APCPSITE(1,0),U,11)="Y"
QUIT
+6 IF APCP("QFLG")
QUIT
+7 IF $DATA(ZTQUEUED)
QUIT
+8 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
+9 IF $DATA(DIRUT)
QUIT
+10 IF 'Y
QUIT
+11 IF Y
SET APCP("APCPTAPE")=""
DO EN^APCPTAPE
+12 IF APCP("QFLG")=99
SET APCP("QFLG")=0
+13 QUIT
+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")>15
WRITE !,"-->There are more than fifteen generations of VISITs stored in the LOG file.",!,"-->Time to do a purge."
+3 QUIT
+4 ;
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 DO EOJ
+6 QUIT
+7 ;
EOJ ; EOJ
+1 DO ^APCPEOJ
+2 QUIT
