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

BLRQINST.m

Go to the documentation of this file. 
  1. BLRQINST ; IHS/DIR/AAB - synchronize all queues before installing patch for one queue; [ 08/01/2002  7:59 AM ]
  1.  ;;5.2;BLR;**1001,1030**;NOV 01, 1997
  1. TSK ; entry point for background job
  1.  ;
  1.  S BLRQUIET=1,U="^",BLRR=""
  1.  L +^BLRLOCK:5 I '$T W !,"Link is running... try again in 10 minutes" Q
  1.  Q:$P($G(^AUTTSITE(1,0)),U,8)'="Y"
  1.  S BLR200CV=$P($P(^DD(9000010.09,1202,0),U,2),"'")="P200"
  1.  D START,EOJ
  1.  L -^BLRLOCK
  1.  W !,"DONE Checking queues",!!
  1.  Q
  1. START ;
  1.  S BLRSSITE=0 F  S BLRSSITE=$O(^BLRSITE(BLRSSITE)) Q:'BLRSSITE  Q:BLRR="^"  D GETSITE
  1.  Q
  1. GETSITE ;
  1.  Q:'$P(^BLRSITE(BLRSSITE,0),U,3)
  1.  ;S BLRDH=$H-10,$Y=24 F  S BLRDH=$O(^BLRSITE(BLRSSITE,21,BLRDH)) Q:'BLRDH  Q:BLRR="^"  S BLRDATA=^BLRSITE(BLRSSITE,21,BLRDH,0) D  Q:BLRR="^"  I $P(BLRDATA,U,3)'=$P(BLRDATA,U,2) W !,"*** Starting Processing The Above Entry ***",!!! D REFILE
  1.  S BLRDH=$H-10,$Y=24 F  S BLRDH=$O(^BLRSITE(BLRSSITE,21,BLRDH)) Q:'BLRDH  Q:BLRR="^"  S BLRDATA=^BLRSITE(BLRSSITE,21,BLRDH,0) I $P(BLRDATA,U,3)'=$P(BLRDATA,U,2) D  Q:BLRR="^"  W !,"*** Starting Processing The Above Entry ***",!!! D REFILE
  1.  .I $Y>24 W "Press Return To Continue " R BLRR:30 Q:BLRR="^"  S $Y=0
  1.  .W ?33,$P(^DIC(4,BLRSSITE,0),U,1)_"("_BLRSSITE_")",!!!
  1.  .W "$H:                           "_BLRDH,!
  1.  .S %H=BLRDH D YX^%DTC W "Date:                     "_Y,!!
  1.  .W "Last Transaction Assigned:    "_$P(BLRDATA,U,2),!
  1.  .W "Last Transaction Processed:   "_$P(BLRDATA,U,3),!!!
  1.  Q
  1. REFILE ;
  1.  S BLRLTA=$P(^BLRSITE(BLRSSITE,21,BLRDH,0),U,2),BLRLTP=$P(BLRDATA,U,3)
  1.  F  S BLRLTP=$O(^BLRSITE(BLRSSITE,21,BLRDH,BLRLTP)) Q:'BLRLTP  D  Q:BLRLTP=BLRLTA
  1.  .S BLRLOGDA=^BLRSITE(BLRSSITE,21,BLRDH,BLRLTP) Q:BLRLOGDA=""
  1.  .S APCDALVR("BLRLINK")=1,BLRERR=0,BLRBUL=0,BLRPCC=""
  1.  .D PROC
  1.  .D:BLRPCC'="" ERR
  1.  .; D:BLRBUL BULTNS
  1.  .D:BLRBUL BULTNS^BLRUTIL3   ; IHS/OIT/MKK - LR*5.2*1030
  1.  .S $P(^BLRSITE(BLRSSITE,21,BLRDH,0),U,3)=BLRLTP
  1.  .D CLNUP
  1.  Q
  1.  ;
  1. PROC ;
  1.  D ^BLRLINK1 Q:BLRERR
  1.  D ^BLRLINK2 Q:BLRERR
  1.  D ^BLRLINK3
  1.  Q
  1.  ;
  1. ERR ; update transaction log with PCC error message value (if transaction is a modification then any previous value needs to be removed)
  1.  K DIE,DA,DR
  1.  S DIE="^BLRTXLOG(",DA=BLRLOGDA,DR="106///^S X=BLRPCC"
  1.  D ^DIE Q
  1.  S BLRBUL=2,BLRPCC="Update to IHS transaction log to the PCC error flag field not done..REFILE"
  1.  W:'BLRQUIET !,"Another user is editing this file entry....update to IHS transaction log to the PCC error flag field not done"
  1.  Q
  1.  ;
  1. SETNUL ; update transaction log with PCC error message value (if transaction is a modification then any previous value needs to be removed)
  1.  K DIE,DA,DR
  1.  S DIE="^BLRTXLOG(",DA=BLRLOGDA,DR="106////@"
  1.  D ^DIE Q
  1.  S BLRBUL=2,BLRPCC="PCC error flag field not nulled."
  1.  W:'BLRQUIET !,"PCC error flag field not nulled"
  1.  Q
  1.  ;
  1. CALLDIK ;DELETE PCC VISIT AND UPDATE BLRTXLOG
  1.  I '$L(BLRVIEN) S BLRPCC="Lab deleted test...PCC entries already deleted" D ERR^BLRLINK Q
  1.  N (BLRLOGDA,DA,DIK,DT,DUZ,U,DTIME,IO,IOSL,IOM,IOXY,IOST,XQDIC,XQPSM,XQY,XQYO,ZTQUEUED)
  1.  S BLRBUL=2,BLRPCC="Lab deleted test...PCC entries deleted"
  1.  D ^DIK,DTXVP
  1.  Q
  1.  ;
  1. DTXVP ; update transaction log to delete PCC file and v ien when lab deletes the test, 
  1.  ; or if PCC entries are missing.
  1.  K DIE,DA,DR
  1.  S DIE="^BLRTXLOG(",DA=BLRLOGDA
  1.  S DR="104////@;105////@;106///^S X=BLRPCC"
  1.  D ^DIE Q
  1.  S BLRPCC=BLRPCC_"PCC error flag field not set.",BLRBUL=2
  1.  W:'BLRQUIET !,BLRPCC,!
  1.  Q
  1.  ;
  1. CLNUP ;
  1.  K APCDALVR,BLR,BLRABNL,BLRACC,BLRANT,BLRANTN,BLRBILL,BLRBUL,BLRBTN,BLRCD,BLRCDT,BLRCLIN,BLRCLNAM,BLRCOM,BLRCOST,BLRCPT,BLRCPTST,BLRDFN,BLRDUZ,BLREPNM,BLRERR,BLREPRV,BLRERR,BLRFILE,BLRVFN,BLRVAL
  1.  K BLRIEN,BLRLINK,BLRLIT,BLRLOGDA,BLRMOD,BLRNAME,BLRNCOM,BLRNMSPC,BLRODT,BLROPNM,BLROPRV,BLRORD,BLRORDL,BLRORG,BLRORGN,BLRPAREN,BLRPATCD,BLRPCC,BLRPMSG,BLRPNAM,BLRPROG,BLRRES,BLRRFH,BLRVFILE,BLRVGL,BLRVFN
  1.  K BLRRFL,BLRROOT,BLRSDI,BLRSITE,BLRSNAM,BLRSS,BLRSTAGE,BLRSTAT,BLRSTR,BLRTLAB,BLRTLOG,BLRTNAM,BLRTRAN,BLRTXT,BLRUNIT,BLRVADFN,BLRVCAT,BLRVFLD,BLRVIEN,BLRVPRV,BLRVSIT,BLRVSUB,BLRXFLG
  1.  Q
  1.  ;
  1.  ;
  1. EOJ ;
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  K APCDALVR,PCCVISIT,INDX,BLR200CV,BLRLOGDA,BLRORD,BLRI,BLRDFN,BLRVADFN,BLRRES,BLRUNIT,BLRACC,BLRSITE,BLRERR,BLRABNL,BLRDATA,BLRSSITE,BLRR
  1.  K BLRTLAB,BLRSS,BLRDFN,AUPNTALK,BLRNMSPC,BLRCDT,BLRCD,BLRCLIN,BLRPATCD,BLRORDL,BLREPRV,BLROPRV,BLREPNM,BLROPNM,BLRSNAM,BLRODT,BLRVAL
  1.  K BLRDUZ,BLRTNAME,BLRXFLG,BLRTRAN,BLRSDI,BLRMOD,BLRL,XMB,BLRPCC,BLRVIEN,BLRPAREN,BLRRFH,BLRRFL,BLRLTA,BLRLTP,BLRQUIET,BLRDH
  1.  Q