- LRCAPV2 ;SLC/AM/DALISC/FHS-STORE WORKLOAD FROM 68 INTO ^LRO(64.1 ;5/2/91 09:03
- ;;5.2;LAB SERVICE;**105,119,153,221**;Sep 27, 1994
- EN ;from LRNIGHT
- S:$D(ZTQUEUED) ZTREQ="@"
- S ZTIO="",ZTRTN="ORU^LA7VMSG",ZTDTH=$H,ZTDESC="SEND LAB LEDI HL7 MESSAGE" D ^%ZTLOAD
- S ZTIO="",ZTRTN="LRCAPPH",ZTDTH=$H,ZTDESC="COLLECT PHLEBOTOMY CAP WORKLOAD" D ^%ZTLOAD
- I $P($G(^LAB(69.9,1,0)),U,14) S ZTIO="",ZTRTN="LRCAPBB",ZTDTH=$H,ZTDESC="COLLECT BLOOD BANK WORKLOAD" D ^%ZTLOAD
- L +^LRO(68,"AA"):1 I '$T G CLEAN
- I $D(XRTL) S XRTN="LRCAPV2" D T0^%ZOSV ; START RESPONSE TIME LOGGING
- S $P(^LAB(69.9,1,"NITE"),U)=$$NOW^LRAFUNC1
- EN1 S (LRII,LRTS,LRCC,LRIN,LRCDT,LRCTM)=""
- F S LRII=$O(^LRO(68,"AA",LRII)) Q:'(LRII]"") S LRAA=$P(LRII,"|"),LRAD=$P(LRII,"|",2),LRAN=$P(LRII,"|",3),LRTS=$P(LRII,"|",4) D LRACC K ^LRO(68,"AA",LRII)
- S $P(^LAB(69.9,1,"NITE"),U)=""
- D CLEAN I $D(XRT0) S XRTN="EN+5^LRCAPV2" D T1^%ZOSV ; STOP RESPONSE TIME LOGGING
- Q
- LRACC ;
- I '$P($G(^LRO(68,+LRAA,0)),U,16) Q
- I (LRAA="")!(LRAD="")!(LRAN="")!(LRTS="") D DUMPIT Q
- S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) I '($L(LRX)) D DUMPIT Q
- S LRSPEC=+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0))
- S LRREC=+$P(LRX,U),LRFNUM=+$P(LRX,U,2),LROAD=$P(LRX,U,3),LROAD1=$P(LRX,U,4),LROAD2=$P(LRX,U,5)
- S LRRRL=$E($P(LRX,U,7),1,20),LRRRL1=$P(LRX,U,8),LRRRL2=$P(LRX,U,9),LRRRL3=$P(LRX,U,10),LRRRL4=$P(LRX,U,11),LROL=$P(LRX,U,13)
- S:LRRRL4="" LRRRL4="Z"
- I (LRFNUM="")!(LRREC="") D DUMPIT Q
- S LRX=$G(^LRO(68,LRAA,0)) I '($L(LRX)) D DUMPIT Q
- S LRLD=$S($L($P(LRX,"^",19)):$P(LRX,"^",19),1:"CP")
- S LRACC=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)) I '($L(LRACC)) D DUMPIT Q
- S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) I '($L(LRX)) D DUMPIT Q
- S LRIDT=$P(LRX,U,5),LRFILE=$S(LRFNUM=2:"DPT(",1:"")
- I LRFILE="" S:$D(^DIC(LRFNUM,0,"GL"))=1 LRFILE=^("GL")
- S LRREC=$S($D(^LR(LRREC,0))#2:$P(^LR(LRREC,0),"^",3),1:"")
- S LRFILE=LRREC_";"_$S($E(LRFILE,1)=U:$E(LRFILE,2,99),1:LRFILE)
- S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,0)) I '($L(LRX)) D DUMPIT Q
- I $E($P(LRX,U,6))="*" D DUMPIT Q
- S LRUG=$P(LRX,U,2)
- F LRCC=0:0 S LRCC=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC)) Q:LRCC<1 D LRCAPC
- Q
- LRCAPC ;
- S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0)) I '$L(LRX) D DUMPIT Q
- ; CHECK COUNTED FOR WORKLOAD IN FILE #68
- Q:$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0),U,3)
- S LRCDT=$P(LRX,U,6),LRCTM=$P(LRCDT,".",2),LRCDT=$P(LRCDT,".") S:LRCTM="" LRCTM="08"
- S LRTEC=$P(LRX,U,7),LRIN=$P(LRX,U,8),LRMA=$P(LRX,U,9),LRLSS=$P(LRX,U,10),LRCNT=$P(LRX,U,2),LRWA=$P(LRX,U,11)
- S:LRIN="" LRIN=$P($G(^XMB(1,1,"XUS")),U,17)
- S:'LRCNT LRCNT=1 S (LRUW,LRCWT)=0
- I $D(^LAM(LRCC,0))#2 S LRX=^(0),LRUW=$P(LRX,"^",3),LRCWT=$P(LRX,"^",11)
- I (LRCC="")!(LRCDT="")!(LRIN="") D DUMPIT Q
- D ^LRCAPV3
- S X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0),$P(X,"^",3)=1,$P(X,"^",4)=$P(X,"^",4)+$P(X,"^",2),^(0)=X
- Q
- DUMPIT ;
- Q ;Comment this line to set trap
- S LRERR=$S($D(^TMP("LR WL ERRORS",0))#2:$P(^(0),U,3),1:0)+1,^TMP("LR WL ERRORS",0)=U_U_LRERR
- S LRESTR="AA= "_$S($D(LRAA):LRAA,1:"")_" AD= "_$S($D(LRAD):LRAD,1:"")_" AN= "_$S($D(LRAN):LRAN,1:"")_" TS= "_$S($D(LRTS):LRTS,1:"")_" CC= "_$S($D(LRCC):LRCC,1:"")_" IN= "_$S($D(LRIN):LRIN,1:"")
- S LRESTR=LRESTR_" CDT= "_$S($D(LRCDT):LRCDT,1:"")_" CT= "_$S($D(LRCTM):LRCTM,1:"")
- S ^TMP("LR WL ERRORS",LRERR,$H)=LRESTR
- Q
- CLEAN ;
- L -^LRO(68,"AA")
- I $D(ZTQUEUED) S ZTREQ="@"
- K LRAA,LRACC,LRAD,LRAN,LRCC,LRCDT,LRCNT,LRCTM,LRFILE,LRFNUM,LRIDT,LRIN,LRLSS,LRMA,LROAD,LROL,LRRREC,LRRRL,LRTEC
- K LRTS,LRUG,LRX,LRZCNT,LRERR,LRQC,LRII,LRNT,LRCWT,LRREC,LRUW,X,LRESTR,LRWA,%,LRLD,LROAD1,LROAD2,LRRRL1,LRRRL2,LRRRL3,LRRRL4
- Q
- TRAP ;
- S $P(^LAB(69.9,1,"NITE"),U)="ERROR"_$P(^("NITE"),U) D @^%ZOSF("ERRTN")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPV2 3709 printed Mar 13, 2025@21:17:50 Page 2
- LRCAPV2 ;SLC/AM/DALISC/FHS-STORE WORKLOAD FROM 68 INTO ^LRO(64.1 ;5/2/91 09:03
- +1 ;;5.2;LAB SERVICE;**105,119,153,221**;Sep 27, 1994
- EN ;from LRNIGHT
- +1 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 SET ZTIO=""
- SET ZTRTN="ORU^LA7VMSG"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="SEND LAB LEDI HL7 MESSAGE"
- DO ^%ZTLOAD
- +3 SET ZTIO=""
- SET ZTRTN="LRCAPPH"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="COLLECT PHLEBOTOMY CAP WORKLOAD"
- DO ^%ZTLOAD
- +4 IF $PIECE($GET(^LAB(69.9,1,0)),U,14)
- SET ZTIO=""
- SET ZTRTN="LRCAPBB"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="COLLECT BLOOD BANK WORKLOAD"
- DO ^%ZTLOAD
- +5 LOCK +^LRO(68,"AA"):1
- IF '$TEST
- GOTO CLEAN
- +6 ; START RESPONSE TIME LOGGING
- IF $DATA(XRTL)
- SET XRTN="LRCAPV2"
- DO T0^%ZOSV
- +7 SET $PIECE(^LAB(69.9,1,"NITE"),U)=$$NOW^LRAFUNC1
- EN1 SET (LRII,LRTS,LRCC,LRIN,LRCDT,LRCTM)=""
- +1 FOR
- SET LRII=$ORDER(^LRO(68,"AA",LRII))
- if '(LRII]"")
- QUIT
- SET LRAA=$PIECE(LRII,"|")
- SET LRAD=$PIECE(LRII,"|",2)
- SET LRAN=$PIECE(LRII,"|",3)
- SET LRTS=$PIECE(LRII,"|",4)
- DO LRACC
- KILL ^LRO(68,"AA",LRII)
- +2 SET $PIECE(^LAB(69.9,1,"NITE"),U)=""
- +3 ; STOP RESPONSE TIME LOGGING
- DO CLEAN
- IF $DATA(XRT0)
- SET XRTN="EN+5^LRCAPV2"
- DO T1^%ZOSV
- +4 QUIT
- LRACC ;
- +1 IF '$PIECE($GET(^LRO(68,+LRAA,0)),U,16)
- QUIT
- +2 IF (LRAA="")!(LRAD="")!(LRAN="")!(LRTS="")
- DO DUMPIT
- QUIT
- +3 SET LRX=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
- IF '($LENGTH(LRX))
- DO DUMPIT
- QUIT
- +4 SET LRSPEC=+$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0))
- +5 SET LRREC=+$PIECE(LRX,U)
- SET LRFNUM=+$PIECE(LRX,U,2)
- SET LROAD=$PIECE(LRX,U,3)
- SET LROAD1=$PIECE(LRX,U,4)
- SET LROAD2=$PIECE(LRX,U,5)
- +6 SET LRRRL=$EXTRACT($PIECE(LRX,U,7),1,20)
- SET LRRRL1=$PIECE(LRX,U,8)
- SET LRRRL2=$PIECE(LRX,U,9)
- SET LRRRL3=$PIECE(LRX,U,10)
- SET LRRRL4=$PIECE(LRX,U,11)
- SET LROL=$PIECE(LRX,U,13)
- +7 if LRRRL4=""
- SET LRRRL4="Z"
- +8 IF (LRFNUM="")!(LRREC="")
- DO DUMPIT
- QUIT
- +9 SET LRX=$GET(^LRO(68,LRAA,0))
- IF '($LENGTH(LRX))
- DO DUMPIT
- QUIT
- +10 SET LRLD=$SELECT($LENGTH($PIECE(LRX,"^",19)):$PIECE(LRX,"^",19),1:"CP")
- +11 SET LRACC=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))
- IF '($LENGTH(LRACC))
- DO DUMPIT
- QUIT
- +12 SET LRX=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
- IF '($LENGTH(LRX))
- DO DUMPIT
- QUIT
- +13 SET LRIDT=$PIECE(LRX,U,5)
- SET LRFILE=$SELECT(LRFNUM=2:"DPT(",1:"")
- +14 IF LRFILE=""
- if $DATA(^DIC(LRFNUM,0,"GL"))=1
- SET LRFILE=^("GL")
- +15 SET LRREC=$SELECT($DATA(^LR(LRREC,0))#2:$PIECE(^LR(LRREC,0),"^",3),1:"")
- +16 SET LRFILE=LRREC_";"_$SELECT($EXTRACT(LRFILE,1)=U:$EXTRACT(LRFILE,2,99),1:LRFILE)
- +17 SET LRX=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,0))
- IF '($LENGTH(LRX))
- DO DUMPIT
- QUIT
- +18 IF $EXTRACT($PIECE(LRX,U,6))="*"
- DO DUMPIT
- QUIT
- +19 SET LRUG=$PIECE(LRX,U,2)
- +20 FOR LRCC=0:0
- SET LRCC=+$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC))
- if LRCC<1
- QUIT
- DO LRCAPC
- +21 QUIT
- LRCAPC ;
- +1 SET LRX=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0))
- IF '$LENGTH(LRX)
- DO DUMPIT
- QUIT
- +2 ; CHECK COUNTED FOR WORKLOAD IN FILE #68
- +3 if $PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0),U,3)
- QUIT
- +4 SET LRCDT=$PIECE(LRX,U,6)
- SET LRCTM=$PIECE(LRCDT,".",2)
- SET LRCDT=$PIECE(LRCDT,".")
- if LRCTM=""
- SET LRCTM="08"
- +5 SET LRTEC=$PIECE(LRX,U,7)
- SET LRIN=$PIECE(LRX,U,8)
- SET LRMA=$PIECE(LRX,U,9)
- SET LRLSS=$PIECE(LRX,U,10)
- SET LRCNT=$PIECE(LRX,U,2)
- SET LRWA=$PIECE(LRX,U,11)
- +6 if LRIN=""
- SET LRIN=$PIECE($GET(^XMB(1,1,"XUS")),U,17)
- +7 if 'LRCNT
- SET LRCNT=1
- SET (LRUW,LRCWT)=0
- +8 IF $DATA(^LAM(LRCC,0))#2
- SET LRX=^(0)
- SET LRUW=$PIECE(LRX,"^",3)
- SET LRCWT=$PIECE(LRX,"^",11)
- +9 IF (LRCC="")!(LRCDT="")!(LRIN="")
- DO DUMPIT
- QUIT
- +10 DO ^LRCAPV3
- +11 SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,1,LRCC,0)
- SET $PIECE(X,"^",3)=1
- SET $PIECE(X,"^",4)=$PIECE(X,"^",4)+$PIECE(X,"^",2)
- SET ^(0)=X
- +12 QUIT
- DUMPIT ;
- +1 ;Comment this line to set trap
- QUIT
- +2 SET LRERR=$SELECT($DATA(^TMP("LR WL ERRORS",0))#2:$PIECE(^(0),U,3),1:0)+1
- SET ^TMP("LR WL ERRORS",0)=U_U_LRERR
- +3 SET LRESTR="AA= "_$SELECT($DATA(LRAA):LRAA,1:"")_" AD= "_$SELECT($DATA(LRAD):LRAD,1:"")_" AN= "_$SELECT($DATA(LRAN):LRAN,1:"")_" TS= "_$SELECT($DATA(LRTS):LRTS,1:"")_" CC= "_$SELECT($DATA(LRCC):LRCC,1:"")_" IN= "_$SELECT($DATA(LRIN):LRIN,1:"")
- +4 SET LRESTR=LRESTR_" CDT= "_$SELECT($DATA(LRCDT):LRCDT,1:"")_" CT= "_$SELECT($DATA(LRCTM):LRCTM,1:"")
- +5 SET ^TMP("LR WL ERRORS",LRERR,$HOROLOG)=LRESTR
- +6 QUIT
- CLEAN ;
- +1 LOCK -^LRO(68,"AA")
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 KILL LRAA,LRACC,LRAD,LRAN,LRCC,LRCDT,LRCNT,LRCTM,LRFILE,LRFNUM,LRIDT,LRIN,LRLSS,LRMA,LROAD,LROL,LRRREC,LRRRL,LRTEC
- +4 KILL LRTS,LRUG,LRX,LRZCNT,LRERR,LRQC,LRII,LRNT,LRCWT,LRREC,LRUW,X,LRESTR,LRWA,%,LRLD,LROAD1,LROAD2,LRRRL1,LRRRL2,LRRRL3,LRRRL4
- +5 QUIT
- TRAP ;
- +1 SET $PIECE(^LAB(69.9,1,"NITE"),U)="ERROR"_$PIECE(^("NITE"),U)
- DO @^%ZOSF("ERRTN")
- +2 QUIT
