BLRNLINK ; IHS/HQT/MJL - LAB HOOK FOR APCDALV (PCC) ; 22-Oct-2013 09:22 ; MKK
;;5.2;IHS LABORATORY;**1010,1011,1013,1024,1030,1033**;NOV 01, 1997
;
;; This routine makes use of the PCC MASTER CONTROL FILE
;; The flag field of this file for the lab package contains the
;; following: 1st piece - 0 = outpatient facility only
;; 1 = outpatient/inpatient facility
;;
;; THE FOLLOWING ARE NOT USED IN BLR 5.2
;; 2nd piece - 0 = don't ask OP/IP prompt
;; 1 = ask OP/IP prompt
;; 3rd piece - 0 = don't ask for ordering facility
;; 1 = ask for ordering facility
;; 4th piece - 0 = don't pass clinic code
;; 1 = pass clinic code
;; each piece is delimited by "~"
;
TSK ; entry point for background job
;
; D ENTRYAUD^BLRUTIL("TSK^BLRNLINK 0.0")
;
Q:$P($G(^AUTTSITE(1,0)),U,8)'="Y"
S BLRQUIET=$G(BLRQUIET)
START ;
; D ENTRYAUD^BLRUTIL("START^BLRNLINK 0.0")
;
S BLRQSITE=$P($G(^AUTTSITE(1,0)),U)
S APCDALVR("BLRLINK")=1
S BLRDH=$P($G(^BLRSITE(BLRQSITE,0)),U,6)
; S:BLRDH="" BLRDH=+$H,$P(^BLRSITE(BLRQSITE,0),U,6)=BLRDH
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1033
I $L(BLRQDH)'=5 D ; If BLRQDH an invalid number, reset it
. D MAKEITSO^BLRUTIL6
. S $P(^BLRSITE(BLRQSITE,0),U,6)=BLRDH
; ----- END IHS/OIT/MKK - LR*5.2*1033
;
S BLR200CV=$P($P($G(^DD(9000010.09,1202,0)),U,2),"'")["P200"
S BLRLTP=+$P($G(^BLRSITE(BLRQSITE,21,BLRDH,0)),U,3)
;
; D ENTRYAUD^BLRUTIL("START^BLRNLINK 1.0","APCDALVR","DUZ")
;
F S BLRXPCC=$G(^BLRSITE(BLRQSITE,0)) D:BLRXPCC="" ERRMST S BLRLOG=$P(BLRXPCC,U,2),BLRSTOP=$P(BLRXPCC,U,9),BLRXPCC=$P(BLRXPCC,U,3) Q:'BLRXPCC!BLRSTOP D Q:BLRHCNT
.S APCDALVR("BLRLINK")=1,BLRERR=0,BLRBUL=0,BLRPCC="",BLRLTA=+$P($G(^BLRSITE(BLRQSITE,21,BLRDH,0)),U,2) S:'BLRLTA BLRLTP=0
.; D ENTRYAUD^BLRUTIL("START^BLRNLINK 1.1","APCDALVR")
.I BLRLOG S BLRX=$G(^BLRSITE(BLRQSITE,20,BLRQDH,0)) I $P(BLRX,U,2)>$P(BLRX,U,3) S BLRHCNT=1 Q
.I BLRLTP=BLRLTA S BLRHCNT=BLRHCNT+1 Q:BLRDH=+$H S BLRHCNT=0,BLRDH=BLRDH+1,$P(^BLRSITE(BLRQSITE,0),U,6)=BLRDH,BLRLTP=0 Q
.S BLRLTP=BLRLTP+1,BLRHCNT=0
.S BLRLOGDA=$G(^BLRSITE(BLRQSITE,21,BLRDH,BLRLTP))
.Q:BLRLOGDA="" ;IF NO EVENT ENTRY THEN JUST PASS IT UP
.S BLRDUZ2=$P($G(^BLRTXLOG(BLRLOGDA,0)),U,9)
.S:BLRDUZ2="" BLRDUZ2=$G(DUZ(2))
.;
.S (BLRORLDN,BLRORLDA)=""
.S BLRORLDZ=$P($G(^BLRTXLOG(BLRLOGDA,11)),U,6)
.S:$G(BLRORLDZ)'="" BLRORLDN=$P($G(^SC(BLRORLDZ,0)),U) ;'NAME'
.S:$G(BLRORLDZ)'="" BLRORLDA=$P($G(^SC(BLRORLDZ,0)),U,2) ;'ABBREVIATION'
.S:$G(BLRORLDZ)'="" BLRORLDZ=$P($G(^SC(BLRORLDZ,0)),U,4) ;'INSTITUTION'
.;
.;IF A MANUAL ACCESSION IS DONE 'BLRFILE' COULD BE THE FOLLOWING
.;62.3 Lab Control Name
.;67 Referral Patient
.;67.1 Research
.;67.2 Sterilizer
.;67.3 Environmental
.;
.;IF BLRFILE IS NOT 2 (PATIENT) THEN DON'T SEND TO PCC
.;AND DON'T SEND ERROR MESSAGES
.;
.;CHECK IF 'INSTITUTION' FIELD IS POPULATED IN THE 'HOSPITAL LOCATION'
.;CHECK FOR 'LAB LOG TO PCC' IS DONE IN BLRNFLTL IHS/ITSC/TPF 06/25/02
.;I $G(BLRORLDZ),$P($G(^BLRSITE(BLRORLDZ,0)),U,3) D PROC
.D PROC ;IHS/ITSC/TPF 06/25/02
.I $G(BLRORLDZ)="",($G(BLRFILE)=2) S BLRBUL=1,BLRPCC="No INSTITUTION entry in the HOSPITAL LOCATION file: "_$G(BLRORLDN),BLRERR=1
.;
.;CHECK IF 'ABBREVIATION' FIELD IS POPULATED IN THE 'HOSPITAL LOCATION'
.;IF NOT SEND ERROR MESSAGE IHS/ITSC/TPF 06/25/02
.I $G(BLRORLDA)="",($G(BLRFILE)=2) S BLRBUL=1,BLRPCC="No ABBREVIATION entry in the HOSPITAL LOCATION file: "_$G(BLRORLDN),BLRERR=1
.D:BLRPCC'="" ERR
.; D:BLRBUL BULTNS
.D:BLRBUL BULTNS^BLRUTIL3 ; IHS/OIT/MKK - LR*5.2*1030
.S $P(^BLRSITE(BLRQSITE,21,BLRDH,0),U,3)=BLRLTP
.D CLNUP
;
; D ENTRYAUD^BLRUTIL("START^BLRNLINK 9.0")
D EOJ
Q
;
PROC ;
D ENTRYAUD^BLRUTIL("PROC^BLRNLINK 0.0","APCDALVR")
D ^BLRLINK1 Q:BLRERR
D ENTRYAUD^BLRUTIL("PROC^BLRNLINK 2.0","APCDALVR") ; IHS/OIT/MKK - LR*5.2*1033
D ^BLRLINK2 Q:BLRERR
D ENTRYAUD^BLRUTIL("PROC^BLRNLINK 3.0","APCDALVR") ; IHS/OIT/MKK - LR*5.2*1033
D ^BLRLINK3
D ENTRYAUD^BLRUTIL("PROC^BLRNLINK 9.0","APCDALVR")
Q
;
;ERROR IF NO 'BLR MASTER CONTROL' FILE
ERRMST ;
; D ENTRYAUD^BLRUTIL("ERRMST^BLRLINK 0.0")
S BLRBUL=1,BLRPCC="No entry for site "_$P($G(^AUTTLOC(BLRQSITE,0)),U,2)_"(ien = "_$G(BLRQSITE)_") in 'BLR MASTER CONTROL' file.",BLRERR=1
D:BLRPCC'="" ERR
; D:BLRBUL BULTNS
D:BLRBUL BULTNS^BLRUTIL3 ; IHS/OIT/MKK - LR*5.2*1030
K BLRBUL,BLRPCC
Q
ERR ; update transaction log with PCC error message value (if transaction is a modification then any previous value needs to be removed)
; D ENTRYAUD^BLRUTIL("ERR^BLRNLINK 0.0")
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)
; D ENTRYAUD^BLRUTIL("SETNUL^BLRLINK 0.0")
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 ;EP - DELETE PCC VISIT AND UPDATE BLRTXLOG
; D ENTRYAUD^BLRUTIL("CALLDIK^BLRNLINK 0.0")
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,
; D ENTRYAUD^BLRUTIL("DTXVP^BLRNLINK 0.0")
; 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
;
DEBUG ;
; Used for debugging only -- called by ^BLRDBG
;
S BLRERR=0,BLRPCC="",BLRQUIET=$G(BLRQUIET),BLR200CV=$P($P(^DD(9000010.09,1202,0),U,2),"'")["P200"
D PROC,ERR:BLRPCC'="",CLNUP,EOJ
Q
;
CLNUP ;
; D ENTRYAUD^BLRUTIL("CLNUP^BLRNLINK 0.0")
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
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 BLRORLDZ,BLRORDL1,BLRCOMPD,BLRCOLSP ;IHS/DIR TUC/AAB 04/08/98
K BLRRFL,BLRROOT,BLRSDI,BLRSITE,BLRSNAM,BLRSS,BLRSTAGE,BLRSTAT,BLRSTR,BLRTLAB,BLRTLOG,BLRTNAM,BLRTRAN,BLRTXT,BLRUNIT,BLRVADFN,BLRVAL,BLRVCAT,BLRVFLD,BLRVIEN,BLRVPRV,BLRVSIT,BLRVSUB,BLRXFLG
Q
;
EOJ ;
; D ENTRYAUD^BLRUTIL("EOJ^BLRNLINK 0.0")
I $D(ZTQUEUED) S ZTREQ="@"
K APCDALVR,PCCVISIT,INDX,BLR200CV,BLRLOGDA,BLRORD,BLRI,BLRDFN,BLRVADFN,BLRRES,BLRUNIT,BLRACC,BLRSITE,BLRERR,BLRABNL,BLRVAL
K BLRTLAB,BLRSS,BLRDFN,AUPNTALK,BLRNMSPC,BLRCDT,BLRCD,BLRCLIN,BLRPATCD,BLRORDL,BLREPRV,BLROPRV,BLREPNM,BLROPNM,BLRSNAM,BLRODT
K BLRDUZ,BLRTNAME,BLRXFLG,BLRTRAN,BLRSDI,BLRMOD,BLRL,XMB,BLRPCC,BLRVIEN,BLRPAREN,BLRRFH,BLRRFL
Q
BLRNLINK ; IHS/HQT/MJL - LAB HOOK FOR APCDALV (PCC) ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;IHS LABORATORY;**1010,1011,1013,1024,1030,1033**;NOV 01, 1997
+2 ;
+3 ;; This routine makes use of the PCC MASTER CONTROL FILE
+4 ;; The flag field of this file for the lab package contains the
+5 ;; following: 1st piece - 0 = outpatient facility only
+6 ;; 1 = outpatient/inpatient facility
+7 ;;
+8 ;; THE FOLLOWING ARE NOT USED IN BLR 5.2
+9 ;; 2nd piece - 0 = don't ask OP/IP prompt
+10 ;; 1 = ask OP/IP prompt
+11 ;; 3rd piece - 0 = don't ask for ordering facility
+12 ;; 1 = ask for ordering facility
+13 ;; 4th piece - 0 = don't pass clinic code
+14 ;; 1 = pass clinic code
+15 ;; each piece is delimited by "~"
+16 ;
TSK ; entry point for background job
+1 ;
+2 ; D ENTRYAUD^BLRUTIL("TSK^BLRNLINK 0.0")
+3 ;
+4 IF $PIECE($GET(^AUTTSITE(1,0)),U,8)'="Y"
QUIT
+5 SET BLRQUIET=$GET(BLRQUIET)
START ;
+1 ; D ENTRYAUD^BLRUTIL("START^BLRNLINK 0.0")
+2 ;
+3 SET BLRQSITE=$PIECE($GET(^AUTTSITE(1,0)),U)
+4 SET APCDALVR("BLRLINK")=1
+5 SET BLRDH=$PIECE($GET(^BLRSITE(BLRQSITE,0)),U,6)
+6 ; S:BLRDH="" BLRDH=+$H,$P(^BLRSITE(BLRQSITE,0),U,6)=BLRDH
+7 ;
+8 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1033
+9 ; If BLRQDH an invalid number, reset it
IF $LENGTH(BLRQDH)'=5
Begin DoDot:1
+10 DO MAKEITSO^BLRUTIL6
+11 SET $PIECE(^BLRSITE(BLRQSITE,0),U,6)=BLRDH
End DoDot:1
+12 ; ----- END IHS/OIT/MKK - LR*5.2*1033
+13 ;
+14 SET BLR200CV=$PIECE($PIECE($GET(^DD(9000010.09,1202,0)),U,2),"'")["P200"
+15 SET BLRLTP=+$PIECE($GET(^BLRSITE(BLRQSITE,21,BLRDH,0)),U,3)
+16 ;
+17 ; D ENTRYAUD^BLRUTIL("START^BLRNLINK 1.0","APCDALVR","DUZ")
+18 ;
+19 FOR
SET BLRXPCC=$GET(^BLRSITE(BLRQSITE,0))
IF BLRXPCC=""
DO ERRMST
SET BLRLOG=$PIECE(BLRXPCC,U,2)
SET BLRSTOP=$PIECE(BLRXPCC,U,9)
SET BLRXPCC=$PIECE(BLRXPCC,U,3)
IF 'BLRXPCC!BLRSTOP
QUIT
Begin DoDot:1
+20 SET APCDALVR("BLRLINK")=1
SET BLRERR=0
SET BLRBUL=0
SET BLRPCC=""
SET BLRLTA=+$PIECE($GET(^BLRSITE(BLRQSITE,21,BLRDH,0)),U,2)
IF 'BLRLTA
SET BLRLTP=0
+21 ; D ENTRYAUD^BLRUTIL("START^BLRNLINK 1.1","APCDALVR")
+22 IF BLRLOG
SET BLRX=$GET(^BLRSITE(BLRQSITE,20,BLRQDH,0))
IF $PIECE(BLRX,U,2)>$PIECE(BLRX,U,3)
SET BLRHCNT=1
QUIT
+23 IF BLRLTP=BLRLTA
SET BLRHCNT=BLRHCNT+1
IF BLRDH=+$HOROLOG
QUIT
SET BLRHCNT=0
SET BLRDH=BLRDH+1
SET $PIECE(^BLRSITE(BLRQSITE,0),U,6)=BLRDH
SET BLRLTP=0
QUIT
+24 SET BLRLTP=BLRLTP+1
SET BLRHCNT=0
+25 SET BLRLOGDA=$GET(^BLRSITE(BLRQSITE,21,BLRDH,BLRLTP))
+26 ;IF NO EVENT ENTRY THEN JUST PASS IT UP
IF BLRLOGDA=""
QUIT
+27 SET BLRDUZ2=$PIECE($GET(^BLRTXLOG(BLRLOGDA,0)),U,9)
+28 IF BLRDUZ2=""
SET BLRDUZ2=$GET(DUZ(2))
+29 ;
+30 SET (BLRORLDN,BLRORLDA)=""
+31 SET BLRORLDZ=$PIECE($GET(^BLRTXLOG(BLRLOGDA,11)),U,6)
+32 ;'NAME'
IF $GET(BLRORLDZ)'=""
SET BLRORLDN=$PIECE($GET(^SC(BLRORLDZ,0)),U)
+33 ;'ABBREVIATION'
IF $GET(BLRORLDZ)'=""
SET BLRORLDA=$PIECE($GET(^SC(BLRORLDZ,0)),U,2)
+34 ;'INSTITUTION'
IF $GET(BLRORLDZ)'=""
SET BLRORLDZ=$PIECE($GET(^SC(BLRORLDZ,0)),U,4)
+35 ;
+36 ;IF A MANUAL ACCESSION IS DONE 'BLRFILE' COULD BE THE FOLLOWING
+37 ;62.3 Lab Control Name
+38 ;67 Referral Patient
+39 ;67.1 Research
+40 ;67.2 Sterilizer
+41 ;67.3 Environmental
+42 ;
+43 ;IF BLRFILE IS NOT 2 (PATIENT) THEN DON'T SEND TO PCC
+44 ;AND DON'T SEND ERROR MESSAGES
+45 ;
+46 ;CHECK IF 'INSTITUTION' FIELD IS POPULATED IN THE 'HOSPITAL LOCATION'
+47 ;CHECK FOR 'LAB LOG TO PCC' IS DONE IN BLRNFLTL IHS/ITSC/TPF 06/25/02
+48 ;I $G(BLRORLDZ),$P($G(^BLRSITE(BLRORLDZ,0)),U,3) D PROC
+49 ;IHS/ITSC/TPF 06/25/02
DO PROC
+50 IF $GET(BLRORLDZ)=""
IF ($GET(BLRFILE)=2)
SET BLRBUL=1
SET BLRPCC="No INSTITUTION entry in the HOSPITAL LOCATION file: "_$GET(BLRORLDN)
SET BLRERR=1
+51 ;
+52 ;CHECK IF 'ABBREVIATION' FIELD IS POPULATED IN THE 'HOSPITAL LOCATION'
+53 ;IF NOT SEND ERROR MESSAGE IHS/ITSC/TPF 06/25/02
+54 IF $GET(BLRORLDA)=""
IF ($GET(BLRFILE)=2)
SET BLRBUL=1
SET BLRPCC="No ABBREVIATION entry in the HOSPITAL LOCATION file: "_$GET(BLRORLDN)
SET BLRERR=1
+55 IF BLRPCC'=""
DO ERR
+56 ; D:BLRBUL BULTNS
+57 ; IHS/OIT/MKK - LR*5.2*1030
IF BLRBUL
DO BULTNS^BLRUTIL3
+58 SET $PIECE(^BLRSITE(BLRQSITE,21,BLRDH,0),U,3)=BLRLTP
+59 DO CLNUP
End DoDot:1
IF BLRHCNT
QUIT
+60 ;
+61 ; D ENTRYAUD^BLRUTIL("START^BLRNLINK 9.0")
+62 DO EOJ
+63 QUIT
+64 ;
PROC ;
+1 DO ENTRYAUD^BLRUTIL("PROC^BLRNLINK 0.0","APCDALVR")
+2 DO ^BLRLINK1
IF BLRERR
QUIT
+3 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("PROC^BLRNLINK 2.0","APCDALVR")
+4 DO ^BLRLINK2
IF BLRERR
QUIT
+5 ; IHS/OIT/MKK - LR*5.2*1033
DO ENTRYAUD^BLRUTIL("PROC^BLRNLINK 3.0","APCDALVR")
+6 DO ^BLRLINK3
+7 DO ENTRYAUD^BLRUTIL("PROC^BLRNLINK 9.0","APCDALVR")
+8 QUIT
+9 ;
+10 ;ERROR IF NO 'BLR MASTER CONTROL' FILE
ERRMST ;
+1 ; D ENTRYAUD^BLRUTIL("ERRMST^BLRLINK 0.0")
+2 SET BLRBUL=1
SET BLRPCC="No entry for site "_$PIECE($GET(^AUTTLOC(BLRQSITE,0)),U,2)_"(ien = "_$GET(BLRQSITE)_") in 'BLR MASTER CONTROL' file."
SET BLRERR=1
+3 IF BLRPCC'=""
DO ERR
+4 ; D:BLRBUL BULTNS
+5 ; IHS/OIT/MKK - LR*5.2*1030
IF BLRBUL
DO BULTNS^BLRUTIL3
+6 KILL BLRBUL,BLRPCC
+7 QUIT
ERR ; update transaction log with PCC error message value (if transaction is a modification then any previous value needs to be removed)
+1 ; D ENTRYAUD^BLRUTIL("ERR^BLRNLINK 0.0")
+2 KILL DIE,DA,DR
+3 SET DIE="^BLRTXLOG("
SET DA=BLRLOGDA
SET DR="106///^S X=BLRPCC"
+4 DO ^DIE
QUIT
+5 SET BLRBUL=2
SET BLRPCC="Update to IHS transaction log to the PCC error flag field not done..REFILE"
+6 IF 'BLRQUIET
WRITE !,"Another user is editing this file entry....update to IHS transaction log to the PCC error flag field not done"
+7 QUIT
+8 ;
SETNUL ; update transaction log with PCC error message value (if transaction is a modification then any previous value needs to be removed)
+1 ; D ENTRYAUD^BLRUTIL("SETNUL^BLRLINK 0.0")
+2 KILL DIE,DA,DR
+3 SET DIE="^BLRTXLOG("
SET DA=BLRLOGDA
SET DR="106////@"
+4 DO ^DIE
QUIT
+5 SET BLRBUL=2
SET BLRPCC="PCC error flag field not nulled."
+6 IF 'BLRQUIET
WRITE !,"PCC error flag field not nulled"
+7 QUIT
+8 ;
CALLDIK ;EP - DELETE PCC VISIT AND UPDATE BLRTXLOG
+1 ; D ENTRYAUD^BLRUTIL("CALLDIK^BLRNLINK 0.0")
+2 IF '$LENGTH(BLRVIEN)
SET BLRPCC="Lab deleted test...PCC entries already deleted"
DO ERR^BLRLINK
QUIT
+3 NEW (BLRLOGDA,DA,DIK,DT,DUZ,U,DTIME,IO,IOSL,IOM,IOXY,IOST,XQDIC,XQPSM,XQY,XQYO,ZTQUEUED)
+4 SET BLRBUL=2
SET BLRPCC="Lab deleted test...PCC entries deleted"
+5 DO ^DIK
DO DTXVP
+6 QUIT
+7 ;
DTXVP ; update transaction log to delete PCC file and v ien when lab deletes the test,
+1 ; D ENTRYAUD^BLRUTIL("DTXVP^BLRNLINK 0.0")
+2 ; or if PCC entries are missing.
+3 KILL DIE,DA,DR
+4 SET DIE="^BLRTXLOG("
SET DA=BLRLOGDA
+5 SET DR="104////@;105////@;106///^S X=BLRPCC"
+6 DO ^DIE
QUIT
+7 SET BLRPCC=BLRPCC_"PCC error flag field not set."
SET BLRBUL=2
+8 IF 'BLRQUIET
WRITE !,BLRPCC,!
+9 QUIT
+10 ;
DEBUG ;
+1 ; Used for debugging only -- called by ^BLRDBG
+2 ;
+3 SET BLRERR=0
SET BLRPCC=""
SET BLRQUIET=$GET(BLRQUIET)
SET BLR200CV=$PIECE($PIECE(^DD(9000010.09,1202,0),U,2),"'")["P200"
+4 DO PROC
IF BLRPCC'=""
DO ERR
DO CLNUP
DO EOJ
+5 QUIT
+6 ;
CLNUP ;
+1 ; D ENTRYAUD^BLRUTIL("CLNUP^BLRNLINK 0.0")
+2 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
+3 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
+4 ;IHS/DIR TUC/AAB 04/08/98
KILL BLRORLDZ,BLRORDL1,BLRCOMPD,BLRCOLSP
+5 KILL BLRRFL,BLRROOT,BLRSDI,BLRSITE,BLRSNAM,BLRSS,BLRSTAGE,BLRSTAT,BLRSTR,BLRTLAB,BLRTLOG,BLRTNAM,BLRTRAN,BLRTXT,BLRUNIT,BLRVADFN,BLRVAL,BLRVCAT,BLRVFLD,BLRVIEN,BLRVPRV,BLRVSIT,BLRVSUB,BLRXFLG
+6 QUIT
+7 ;
EOJ ;
+1 ; D ENTRYAUD^BLRUTIL("EOJ^BLRNLINK 0.0")
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 KILL APCDALVR,PCCVISIT,INDX,BLR200CV,BLRLOGDA,BLRORD,BLRI,BLRDFN,BLRVADFN,BLRRES,BLRUNIT,BLRACC,BLRSITE,BLRERR,BLRABNL,BLRVAL
+4 KILL BLRTLAB,BLRSS,BLRDFN,AUPNTALK,BLRNMSPC,BLRCDT,BLRCD,BLRCLIN,BLRPATCD,BLRORDL,BLREPRV,BLROPRV,BLREPNM,BLROPNM,BLRSNAM,BLRODT
+5 KILL BLRDUZ,BLRTNAME,BLRXFLG,BLRTRAN,BLRSDI,BLRMOD,BLRL,XMB,BLRPCC,BLRVIEN,BLRPAREN,BLRRFH,BLRRFL
+6 QUIT
