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

BCHEXD.m

Go to the documentation of this file. 
  1. BCHEXD ; IHS/CMI/LAB - MAIN DRIVER FOR CHR EXPORT TX GEN ; 
  1.  ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
  1.  ;IHS/CMI/LAB - PATCH 10 NEW RECORD FORMAT
  1.  ;IHS/CMI/LAB ;added $J to ^TMP
  1.  ;
  1.  ;Main driver routine for the generation of transactions to be
  1.  ;exported to the CHR System.
  1.  ;
  1. START ;
  1.  I $D(ZTQUEUED) S BCHO("SCHEDULED")=""
  1.  S BCHO("RUN")="NEW" ;      Let BCHEXDI know this is a new run.
  1.  D ^BCHEXDI ;           Do initialization
  1.  I $D(BCHO("QUEUE")) D EOJ W !!,"Okay, your request is queued!  Bye",! Q
  1.  I BCH("QFLG")=99 D EOJ W !!,"Bye",!! Q
  1.  I BCH("QFLG") D ABORT Q
  1. DRIVER ;called from TSKMN+2
  1.  S BCH("BT")=$H
  1.  D NOW^%DTC S BCH("RUN START")=%,BCH("MAIN TX DATE")=$P(%,".") K %,%H,%I
  1.  S DIE="^BCHXLOG(",DA=BCH("RUN LOG"),DR=".15///R"_";.03////"_BCH("RUN START") D CALLDIE^BCHUTIL
  1.  I $D(Y) D ABORT Q
  1.  S BCHCNT=$S('$D(ZTQUEUED):"X BCHCNT1  X BCHCNT2",1:"S BCHCNTR=BCHCNTR+1"),BCHCNT1="F BCHCNTL=1:1:$L(BCHCNTR)+1 W @BCHBS",BCHCNT2="S BCHCNTR=BCHCNTR+1 W BCHCNTR,"")"""
  1.  D PROCESS ;            Generate trasactions
  1.  I BCH("QFLG") D ABORT Q
  1.  D ^BCHEXLOG ;                Update Log
  1.  I BCH("QFLG") D ABORT Q
  1.  D PURGE ;              Purge AEX xref entries
  1.  D RUNTIME^BCHEXEOJ ;            Show run time
  1.  D TAPE ; Write transactions to tape
  1.  I BCH("QFLG") D ABORT Q
  1.  D:'$D(ZTQUEUED) CHKLOG ;             See if Log needs cleaning
  1.  I '$D(ZTQUEUED) W !! S DIR(0)="E",DIR("A")="DONE  --  Press RETURN to Continue" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  D EOJ
  1.  Q
  1.  ;
  1. PROCESS ;
  1.  ;build header record
  1.  ;S BCH("COUNT")=BCH("COUNT")+1
  1.  W:'$D(ZTQUEUED) !,"Generating transactions.  Counting records.  (1)"
  1.  S BCHCNTR=0,BCH("CONTROL DATE")=BCH("RUN BEGIN")-1,BCH("POSTING DATE")="      "
  1.  S BCHRTYPE="U"
  1.  F  S BCH("CONTROL DATE")=$O(^BCHR("AEX",BCH("CONTROL DATE"))) Q:BCH("CONTROL DATE")=""!(BCH("CONTROL DATE")>BCH("RUN END"))  D PROCESS2 Q:BCH("QFLG")
  1.  S BCHRTYPE="D" D DELETES ;gather up and send deletes
  1.  Q
  1. PROCESS2 ;
  1.  S BCHR="" F  S BCHR=$O(^BCHR("AEX",BCH("CONTROL DATE"),BCHR)) Q:BCHR=""  D PROCESS3 Q:BCH("QFLG")
  1.  Q
  1. PROCESS3 ;
  1.  I '$D(^BCHR(BCHR,0)) K ^BCHR("AEX",BCH("CONTROL DATE"),BCHR) Q  ;IHS/CMI/LAB - missing record
  1.  K BCHE,BCHCPOV
  1.  Q:$D(^BCHXLOG(BCH("RUN LOG"),21,BCHR))
  1.  S BCHV("TX GENERATED")=0,^TMP("BCHDR",$J,BCH("CONTROL DATE"),BCHR)="",^TMP("BCHDR",$J,"MAIN TX",BCHR)=""
  1.  S BCH("VISIT COUNT")=BCH("VISIT COUNT")+1
  1.  X BCHCNT
  1.  I '$D(^BCHRPROB("AD",BCHR)) S BCHE="E021" D CNTBUILD Q
  1.  S BCHREC=^BCHR(BCHR,0)
  1.  K BCHE,BCHTX S (BCHCPOV,BCHPOVD)=0 F  S BCHPOVD=$O(^BCHRPROB("AD",BCHR,BCHPOVD)) Q:BCHPOVD'=+BCHPOVD  D
  1.  .I $P(^BCHRPROB(BCHPOVD,0),U,4)=""!($P(^BCHRPROB(BCHPOVD,0),U,5)="")!($P(^BCHRPROB(BCHPOVD,0),U,6)="") S BCHE="E021" Q
  1.  .;D RECORD^BCHEXD2
  1.  .;D CNTBUILD
  1.  I $D(BCHE) D CNTBUILD Q  ;IHS/CMI/LAB - new format
  1.  D ^XBFMK
  1.  K BCHE,BCHTX,BCH("POVS")
  1.  D RECORD^BCHEXD2
  1.  D CNTBUILD
  1.  S DA=BCH("RUN LOG"),DR="2101///""`"_BCHR_"""",DIE="^BCHXLOG("
  1.  S DR(2,90002.912101)=".02////"_BCHV("TX GENERATED")_";.03///"_BCHRTYPE
  1.  D CALLDIE^BCHUTIL
  1.  Q
  1.  ;
  1. PURGE ; PURGE 'AEX' XREF FOR CHR RECORDS JUST DONE
  1.  W:'$D(ZTQUEUED) !,"Deleting cross-reference entries. (1)"
  1.  S BCHCNTR=0,BCHV("R DATE")=""
  1.  F  S BCHV("R DATE")=$O(^TMP("BCHDR",$J,BCHV("R DATE"))) Q:BCHV("R DATE")'=+BCHV("R DATE")  D PURGE2
  1. DEL ;update delete file
  1.  S BCHV("R DATE")=""
  1.  F  S BCHV("R DATE")=$O(^TMP("BCHDR",$J,"DELETES",BCHV("R DATE"))) Q:BCHV("R DATE")'=+BCHV("R DATE")  D
  1.  .S BCHR=0 F  S BCHR=$O(^TMP("BCHDR",$J,"DELETES",BCHV("R DATE"),BCHR)) Q:BCHR'=+BCHR  D
  1.  ..S DIE="^BCHEXDEL(",DA=BCHR,DR=".06////"_BCH("MAIN TX DATE") D CALLDIE^BCHUTIL
  1.  K ^TMP("BCHDR")
  1.  Q
  1. PURGE2 ;
  1.  S BCHR="" F  S BCHR=$O(^TMP("BCHDR",$J,BCHV("R DATE"),BCHR)) Q:BCHR=""  D RESET
  1.  Q
  1.  ;
  1. RESET ; kill CHR xref and set flag if tx 23 or 24 generated
  1.  K ^BCHR("AEX",BCHV("R DATE"),BCHR)
  1.  I ^TMP("BCHDR",$J,"MAIN TX",BCHR)]"" S DIE="^BCHR(",DA=BCHR,DR=".19///"_^TMP("BCHDR",$J,"MAIN TX",BCHR) D CALLDIE^BCHUTIL
  1.  X BCHCNT
  1.  Q
  1.  ;
  1.  ;
  1. CNTBUILD ;EP count and build tx
  1.  I BCHE]"" S BCH("ERROR COUNT")=BCH("ERROR COUNT")+1 D ^BCHEXERR Q
  1.  S BCH("COUNT")=BCH("COUNT")+1
  1.  S BCH(BCHRTYPE)=BCH(BCHRTYPE)+1
  1.  S BCHV("TX GENERATED")=1,^TMP("BCH"_$S(BCHO("RUN")="NEW":"DR",BCHO("RUN")="REDO":"REDO",1:"DR"),$J,"MAIN TX",BCHR)=BCH("MAIN TX DATE")
  1.  ;S ^BCHRDATA(BCH("COUNT"))="CR^"_BCHTX ;IHS/CMI/LAB - new format
  1.  S ^BCHRDATA(BCH("COUNT"))=BCHTX
  1.  S X=0 F  S X=$O(BCH("POVS",X)) Q:X'=+X  S BCH("COUNT")=BCH("COUNT")+1,^BCHRDATA(BCH("COUNT"))=BCH("POVS",X) ;IHS/CMI/LAB - new format
  1.  Q
  1. TAPE ; COPY TRANSACTIONS TO TAPE
  1.  D TAPE^BCHEXTAP
  1.  Q
  1.  ;
  1. CHKLOG ; CHECK LOG FILE
  1.  ;S BCH("X")=0 F BCH("I")=BCH("RUN LOG"):-1:1 Q:'$D(^BCHXLOG(BCH("I")))  I $O(^BCHXLOG(BCH("I"),21,0)) S BCH("X")=BCH("X")+1
  1.  ;I BCH("X")>12 W !,"-->There are more than twelve generations of CHR RECORDs stored in the LOG file.",!,"-->Time to do a purge."
  1.  Q
  1.  ;
  1. ABORT ; ABNORMAL TERMINATION
  1.  I $D(BCH("RUN LOG")) S BCH("QFLG1")=$O(^BCHDTER("B",BCH("QFLG"),"")),DA=BCH("RUN LOG"),DIE="^BCHXLOG(",DR=".15///F;.16////"_BCH("QFLG1")
  1.  I $D(ZTQUEUED) D ERRBULL^BCHEXDI3,EOJ Q
  1.  W !!,"Abnormal termination!!  QFLG=",BCH("QFLG")
  1.  S DIR(0)="E",DIR("A")="DONE  --  Press RETURN to Continue" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  D EOJ
  1.  Q
  1.  ;
  1. DELETES ;
  1.  D DELETES^BCHEXD2
  1.  Q
  1. EOJ ; EOJ
  1.  D ^BCHEXEOJ
  1.  Q