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

APCPDR.m

Go to the documentation of this file. 
  1. 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
  1. START ;EP - called from option
  1.  I $D(ZTQUEUED) S APCPO("SCHEDULED")=""
  1.  S APCPO("RUN")="NEW" ;      Let APCPDRI know this is a new run.
  1.  D ^APCPDRI ;           Do initialization
  1.  I $D(APCPO("QUEUE")) D EOJ W !!,"Okay, request queued!!",!! Q
  1.  I APCP("QFLG")=99 D EOJ W !!,"Bye",!! Q
  1.  I APCP("QFLG") D ABORT Q
  1. DRIVER ;EP called from TSKMN+2
  1.  S APCP("BT")=$H
  1.  D NOW^%DTC S APCP("RUN START")=%,APCP("MAIN TX DATE")=$P(%,".") K %,%H,%I
  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.  S DIE="^APCPLOG(",DA=APCP("RUN LOG"),DR=".24///"_APCP("FILENAME")_";.15///R"_";.03////"_APCP("RUN START") D ^DIE K DA,DIE,DR
  1.  ;D ^APCPFIXD
  1.  I APCP("QFLG") D ABORT Q
  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 PROCESS ;            Generate trasactions
  1.  I APCP("QFLG") D ABORT Q
  1.  D ^APCPLOG ;                Update Log
  1.  I APCP("QFLG") D ABORT Q
  1.  D PURGE ;              Purge APCIS xref entries
  1.  D RUNTIME^APCPEOJ ;            Show run time
  1.  D TAPE ; Write transactions to tape
  1.  I APCP("QFLG") D ABORT Q
  1.  D:'$D(ZTQUEUED) CHKLOG ;             See if Log needs cleaning
  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.  Q
  1.  ;
  1. PROCESS ;
  1.  S ^XTMP("APCPDR",0)=$$FMADD^XLFDT(DT,14)_U_DT_"PCC DATA TRANSMISSION" ;IHS/CMI/LAB - patch 2
  1.  W:'$D(ZTQUEUED) !,"Generating transactions.  Counting visits.  (1)"
  1.  S APCPCNTR=0,APCP("CONTROL DATE")=APCP("RUN BEGIN")-1,APCP("POSTING DATE")="      "
  1.  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")
  1.  Q
  1. PROCESS2 ;
  1.  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")
  1.  Q
  1. PROCESS3 ;
  1.  K APCPT,APCPV,APCPE
  1.  D KILL^AUPNPAT
  1.  Q:$D(^APCPLOG(APCP("RUN LOG"),21,APCP("V DFN")))
  1.  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
  1.  X APCPCNT
  1.  Q:'$D(^AUPNVSIT(APCP("V DFN"),0))
  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.  S APCPV("V DATE")=+APCPV("V REC")\1
  1.  D ^APCPDR2
  1.  S:'$D(^APCPLOG(APCP("RUN LOG"),21,0)) ^APCPLOG(APCP("RUN LOG"),21,0)="^9001005.2101PA^^"
  1.  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")
  1.  S $P(^APCPLOG(APCP("RUN LOG"),21,0),U,3)=APCP("V DFN"),$P(^(0),U,4)=$P(^(0),U,4)+1
  1.  K DIE,DR,DIC
  1.  Q
  1.  ;
  1. PURGE ; PURGE 'APCIS' XREF FOR VISITS JUST DONE
  1.  W:'$D(ZTQUEUED) !,"Deleting cross-reference entries. (1)"
  1.  S APCPCNTR=0,APCPV("V DATE")=0 ;IHS/CMI/LAB patch 2 set to 0
  1.  F  S APCPV("V DATE")=$O(^XTMP("APCPDR",APCPV("V DATE"))) Q:APCPV("V DATE")'=+APCPV("V DATE")  D PURGE2
  1.  K ^XTMP("APCPDR")
  1.  Q
  1. PURGE2 ;
  1.  S APCP("V DFN")="" F  S APCP("V DFN")=$O(^XTMP("APCPDR",APCPV("V DATE"),APCP("V DFN"))) Q:APCP("V DFN")=""  D RESET
  1.  Q
  1.  ;
  1. RESET ; kill PCIS xref and set flag if tx 23 or 24 generated
  1.  K ^AUPNVSIT("APCIS",APCPV("V DATE"),APCP("V DFN"))
  1.  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
  1.  X APCPCNT
  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 ERRBULL^APCPDRI3
  1.  ;D EN^APCPTAPE I $D(ZTQUEUED),APCP("QFLG") D ERRBULL^APCPDRI3
  1.  I APCP("DEF DEVICE")="F",$P(^APCPSITE(1,0),U,11)="Y" Q
  1.  Q:APCP("QFLG")
  1.  Q:$D(ZTQUEUED)
  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. 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")>15 W !,"-->There are more than fifteen generations of VISITs stored in the LOG file.",!,"-->Time to do a purge."
  1.  Q
  1.  ;
  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.  D EOJ
  1.  Q
  1.  ;
  1. EOJ ; EOJ
  1.  D ^APCPEOJ
  1.  Q