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