Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCPREDO

APCPREDO.m

Go to the documentation of this file. 
  1. 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
  1.  ;IHS/CMI/LAB - xtmp/new stat record
  1. START ;
  1.  S APCPO("RUN")="REDO" ;     Let ^APCPDRI know this is a 'REDO'
  1.  D ^APCPDRI ;           
  1.  I APCP("QFLG") D EOJ W !!,"Bye",!! Q
  1.  D INIT ;               Get Log entry to redo
  1.  I APCP("QFLG") D EOJ W !!,"Bye",!! Q
  1.  D QUEUE^APCPDRI
  1.  I APCP("QFLG") D EOJ W !!,"Bye",!! Q
  1.  I $D(APCPO("QUEUE")) D EOJ W !!,"Okay your request is queued!",!! Q
  1.  ;
  1. EN ;EP FROM TASKMAN
  1.  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,"")"""
  1.  D NOW^%DTC S APCP("RUN START")=%,APCP("MAIN TX DATE")=$P(%,".") K %,%H,%I
  1.  S APCP("BT")=$HOROLOG
  1.  S X2=$E(DT,1,3)_"0101",X1=DT D ^%DTC S APCPJD=X+1
  1.  S APCP("FILENAME")=""
  1.  I $P(^AUTTSITE(1,0),U,21)=1 S APCP("FILENAME")="BAPC"_$P(^AUTTSITE(1,1),U,3)_"."_APCPJD
  1.  I $P(^AUTTSITE(1,0),U,21)'=1 D
  1.  .I ^%ZOSF("OS")["NT" S APCP("FILENAME")="BAPC"_$P(^AUTTSITE(1,1),U,3)_"."_APCPJD Q
  1.  .S APCP("FILENAME")="BAPC"_$E($P(^AUTTSITE(1,1),U,3),3,6)_"."_APCPJD
  1.  D ^XBFMK S DA=APCP("RUN LOG"),DR=".24///"_APCP("FILENAME")_";.25///1",DIE="^APCPLOG(" D ^DIE D ^XBFMK
  1.  D PROCESS ;            Generate transactions
  1.  I APCP("QFLG") W:'$D(ZTQUEUED) !!,"Abnormal termination!  QFLG=",APCP("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
  1.  D ^APCPRLOG ;                Update Log entry
  1.  I APCP("QFLG") W:'$D(ZTQUEUED) !!,"Log error! ",APCP("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
  1.  D:'$D(ZTQUEUED) RUNTIME^APCPEOJ
  1.  I APCP("QFLG") W:'$D(ZTQUEUED) !!,"Tape creation error! QFLG=",APCP("QFLG") D:$D(ZTQUEUED) ABORT D EOJ Q
  1.  D:'$D(ZTQUEUED) CHKLOG ;             See if Log needs cleaning
  1.  D RESETV ;             Reset VISITs processed in Log
  1.  D TAPE ; Write transactions to tape
  1.  I '$D(ZTQUEUED) S DIR(0)="EO",DIR("A")="DONE -- Press RETURN to Continue" K DA D ^DIR K DIR
  1.  D EOJ
  1.  K APCP
  1.  Q
  1.  ;
  1. PROCESS ;
  1.  S ^XTMP("APCPREDO",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"PCC EXPORT REDO" ;IHS/CMI/LAB
  1.  W:'$D(ZTQUEUED) !,"Generating transactions.  Counting visits.  (1)" S APCPCNTR=0
  1.  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")
  1.  Q
  1. PROCESS2 ;
  1.  K APCPE,APCPV
  1.  X APCPCNT
  1.  S ^XTMP("APCPREDO","MAIN TX",APCP("V DFN"))="",APCPV("TX GENERATED")=0,APCPV("STAT TX GEN")=0
  1.  I '$D(^AUPNVSIT(APCP("V DFN"))) Q
  1.  I $P($G(^AUPNVSIT(APCP("V DFN"),11)),U,4)="" S $P(^AUPNVSIT(APCP("V DFN"),11),U,4)=$$UID^AUPNVSIT(APCP("V DFN"))
  1.  S APCPV("V REC")=^AUPNVSIT(APCP("V DFN"),0)
  1.  ;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
  1.  S APCPV("V DATE")=+APCPV("V REC")\1
  1.  S APCP("POSTING DATE")="      "
  1.  D ^APCPDR2
  1. 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")
  1.  Q
  1.  ;
  1. TAPE ; COPY TRANSACTIONS TO TAPE
  1.  S APCP("DEF DEVICE")=$P(^APCPSITE(1,0),U,2)
  1.  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
  1.  I APCP("DEF DEVICE")="F",$P(^APCPSITE(1,0),U,11)'="N" D EN^APCPTAPE I $D(ZTQUEUED),APCP("QFLG") D ABORT
  1.  Q:APCP("QFLG")
  1.  Q:$D(ZTQUEUED)
  1.  Q:$P(^APCPSITE(1,0),U,11)="Y"
  1.  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
  1.  Q:$D(DIRUT)
  1.  Q:'Y
  1.  I Y S APCP("APCPTAPE")="" D EN^APCPTAPE
  1.  I APCP("QFLG")=99 S APCP("QFLG")=0
  1.  Q
  1.  ;
  1.  ;
  1. CHKLOG ; CHECK LOG FILE
  1.  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
  1.  I APCP("X")>3 W !!,"-->There are more than three generations of VISITs stored in the LOG file.",!,"-->Time to do a purge."
  1.  Q
  1.  ;
  1. RESETV ; RESET VISIT DATA IN LOG
  1.  W:'$D(ZTQUEUED) !,"Resetting VISIT specific data in Log file.  (1)" S APCPCNTR=0
  1.  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
  1.  W:'$D(ZTQUEUED) !,"Resetting VISIT TX Flags. (1)" S APCPCNTR=0
  1.  S APCP("X")=0 F  S APCP("X")=$O(^XTMP("APCPREDO","MAIN TX",APCP("X"))) Q:APCP("X")'=+APCP("X")  D
  1.  .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
  1.  .Q
  1.  K ^XTMP("APCPREDO")
  1.  Q
  1.  ;
  1. INIT ;
  1.  D INIT^APCPRED1
  1.  Q
  1. ABORT ; ABNORMAL TERMINATION
  1.  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")
  1.  I $D(ZTQUEUED) D ERRBULL^APCPDRI3,EOJ Q
  1.  W !!,"Abnormal termination!!  QFLG=",APCP("QFLG")
  1.  S DIR(0)="EO",DIR("A")="Press any key to continue" K DA D ^DIR K DIR
  1.  Q
  1.  ;
  1. EOJ ;
  1.  D ^APCPEOJ
  1.  Q