- LRCAPBB ;SLC/AM/DALISC/FHS - STORE WORKLOAD FROM 65,65.5 INTO ^LRO(64.1 ; 4/4/07 7:40am
- ;;5.2;LAB SERVICE;**1002,1006,1031**;NOV 1, 1997
- ;
- ;;VA LR Patche(s): 72,201,325
- ;
- ;Reference to ^%ZTLOAD supported by IA #1519
- ;Reference to $$NOW^XLFDT supported by IA #10103
- ;VBECS workload included in process
- EN ;
- Q:'$P($G(^LAB(69.9,1,0)),U,14)
- S:'$D(^LAB(69.9,1,"NITE")) ^("NITE")=""
- VBEC ;Process VBECS workload collection
- N ZTIO,ZTRTN,ZTDTH
- I ZTDESC="COLLECT BLOOD BANK WORKLOAD" S ZTIO="",ZTRTN="LRCAPBV",ZTDTH=$H,ZTDESC="COLLECT VBECS WORKLOAD DATA" D ^%ZTLOAD
- L +^LRD(65,"AA"):1 I '$T G FIN
- L +^LRE("AA"):1 I '$T G FIN
- S $P(^LAB(69.9,1,"NITE"),"^",4)=$$NOW^XLFDT
- ;S X="TRAP^LRCAPBB",@^%ZOSF("TRAP")
- INVENT ;
- D INIT G:'$O(^LRD(65,"AA",0)) DONOR D FT
- I LRERR K ^LRD(65,"AA") D DUMP S ^TMP("LR WL ERRORS",LRX)="BASIC LRD(65 DATA MISSING" G DONOR
- F S LRREC=$O(^LRD(65,"AA",LRREC)) Q:LRREC="" S LRTS="" D
- .S LRFILE=LRREC_";LRD(65," F S LRTS=$O(^LRD(65,"AA",LRREC,LRTS)) Q:LRTS="" S LRDTTM="" F S LRDTTM=$O(^LRD(65,"AA",LRREC,LRTS,LRDTTM)) Q:LRDTTM="" S LRACC=^(LRDTTM) D K ^LRD(65,"AA",LRREC,LRTS,LRDTTM)
- ..S LRCC=0 F S LRCC=$O(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC)) Q:LRCC<1 D
- ...; LRRRL3 is the log in person, LRRRL4 is location type
- ...;S $P(^LAB(69.9,1,"NITE"),U,4)=LRREC_"99 "_LRTS_","_LRDTTM_","_LRCC
- ...S LRX=$G(^LRD(65,LRREC,99,LRTS,1,LRDTTM,0)),LRRRL3=$P(LRX,U,2),LRIN=$P(LRX,U,3),(LRAA,LRMA)=+$P(LRX,U,4),LRLSS=+$P(LRX,U,5) S:'LRLSS LRLSS=LRMA D CHK
- ...S LRX=$G(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC,0)),LRCNT=+$P(LRX,U,2)
- ...S:'LRCNT LRCNT=1
- ...S LRCTM=$P(LRDTTM,".",2),LRCDT=$P(LRDTTM,"."),(LRUW,LRCWT)=1
- ...I $D(^LAM(LRCC,0))#2 S LRX=^(0),LRUW=$P(LRX,"^",3),LRCWT=$P(LRX,"^",11)
- ...I (LRIN="")!(LRCC="")!(LRCDT="")!(LRCTM="")!(LRTS="") D DUMP Q
- ...W:'$D(ZTQUEUED) !,"WKLD CODE "_LRCC
- ...D ^LRCAPV3
- ...S $P(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC,0),"^",3)=1
- ..Q
- DONOR ;
- I '$O(^LRE("AA",0)) G FIN
- S LRERR=0,LRREC="" D FT2
- I LRERR K ^LRE("AA") D DUMP S ^TMP("LR WL ERRORS",LRX)="BASIC LRE( DATA MISSING" G FIN
- F S LRREC=$O(^LRE("AA",LRREC)) Q:LRREC="" S LRI="",LRFILE=LRREC_";LRE(" F S LRI=$O(^LRE("AA",LRREC,LRI)) Q:LRI="" S LRTS="" F S LRTS=$O(^LRE("AA",LRREC,LRI,LRTS)) Q:LRTS="" D
- .S LRDTTM="" F LRDTTM=$O(^LRE("AA",LRREC,LRI,LRTS,LRDTTM)) Q:LRDTTM="" S LRACC=^(LRDTTM) D
- ..W:'$D(ZTQUEUED) !?5,"DONOR "_LRDTTM
- ..S LRCC=0 F S LRCC=$O(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,1,LRCC)) Q:LRCC<1 D K ^LRE("AA",LRREC,LRI,LRTS,LRDTTM)
- ...; LRRRL3 is the log in person, LRRRL4 is location type
- ...;S $P(^LAB(69.9,1,"NITE"),U,4)=LRREC_"5 "_LRI_"99 "_LRTS_","_LRDTTM_","_LRCC
- ...S LRX=$G(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,0)),LRRRL3=$P(LRX,U,2)
- ...S LRX=$G(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,1,LRCC,0)),LRCNT=+$P(LRX,U,2)
- ...S:'LRCNT LRCNT=1
- ...S LRCTM=$P(LRDTTM,".",2),LRCDT=$P(LRDTTM,"."),(LRWU,LRCWT)=1
- ...I $D(^LAM(LRCC,0))#2 S LRX=^(0),LRUW=$P(LRX,"^",3),LRCWT=$P(LRX,"^",11)
- ...I (LRIN="")!(LRCC="")!(LRCDT="")!(LRCTM="")!(LRTS="") D DUMP Q
- ...D ^LRCAPV3
- ...S $P(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,1,LRCC,0),"^",3)=1
- ..Q
- FIN S $P(^LAB(69.9,1,"NITE"),"^",4)="" L -^LRD(65,"AA") L -^LRE("AA")
- I $D(ZTQUEUED) S ZTREQ="@"
- D CLEAN
- Q
- FT ;
- S LRX=$G(^LAB(69.9,1,8.1,+$G(^LAB(69.9,1,10)),0)),LRIN=$P(LRX,U),(LRAA,LRMA)=+$P(LRX,U,2),LRLSS=+$P(LRX,U,3) S:'LRLSS LRLSS=LRMA D CHK
- Q
- FT2 ;
- S LRX=$G(^LAB(69.9,1,8.1,+$G(^LAB(69.9,1,10)),0)),LRIN=$P(LRX,U),(LRAA,LRMA)=+$P(LRX,U,4),LRLSS=+$P(LRX,U,5) S:'LRLSS LRLSS=LRMA D CHK
- Q
- CHK S LRERR=$S('LRIN:1,'LRMA:1,1:0) Q:LRERR
- S:'$D(^LRO(68,LRMA,0))#2 LRERR=1 Q:LRERR S LRX=^(0) I '$P(LRX,U,16) S LRERR=1 Q
- S:'LRLSS LRLSS=LRMA S LRWA=LRLSS
- S LRLD=$S($L($P(LRX,U,19)):$P(LRX,U,19),1:"CP")
- Q
- DUMP ;
- S LRX=$S($D(^TMP("LR WL ERRORS",0))#2:$P(^(0),U,3),1:0)+1,^TMP("LR WL ERRORS",0)=U_U_LRX
- S LRESTR="BLOOD BANK RECORD= "_$S($D(LRREC):LRREC,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",LRX,$H)=LRESTR
- Q
- CLEAN ;
- Q:$D(TEST) K LRACC,LRAD,LRCC,LRDTTM,LRCDT,LRCNT,LRCTM,LRFILE,LRIDT,LRIN,LRLSS,LRMA
- K LROAD,LROL,LRRREC,LRRRL,LRTEC,LRTS,LRUG,LRX,LRZCNT,LRERR,LRQC,LRII
- K LRNT,LRCWT,LRREC,LRUW,X,LRESTR,LRWA,%,LRLD,LROAD1,LROAD2,LRRRL1
- K LRRRL2,LRRRL3,LRRRL4,LRI,LRFIRST,LRFNUM,LREND
- Q
- INIT ;
- S (LRREC,LRTS,LRACC,LROAD,LROAD1,LROAD2,LRRRL,LRRRL1,LRRRL2,LRRRL3,LROL,LRII,LRIDT,LRTEC,LRFNUM,LRERR)="",LRRRL4="Z",LRUG=50 ; These variables are needed by LRCAPV3
- Q
- TRAP ;
- S LREND=1 S:$D(^LAB(69.9,1,"NITE")) $P(^LAB(69.9,1,"NITE"),U,4)="ERROR"_$P(^("NITE"),"^",4) D @^%ZOSF("ERRTN")
- Q
- LRCAPBB ;SLC/AM/DALISC/FHS - STORE WORKLOAD FROM 65,65.5 INTO ^LRO(64.1 ; 4/4/07 7:40am
- +1 ;;5.2;LAB SERVICE;**1002,1006,1031**;NOV 1, 1997
- +2 ;
- +3 ;;VA LR Patche(s): 72,201,325
- +4 ;
- +5 ;Reference to ^%ZTLOAD supported by IA #1519
- +6 ;Reference to $$NOW^XLFDT supported by IA #10103
- +7 ;VBECS workload included in process
- EN ;
- +1 IF '$PIECE($GET(^LAB(69.9,1,0)),U,14)
- QUIT
- +2 IF '$DATA(^LAB(69.9,1,"NITE"))
- SET ^("NITE")=""
- VBEC ;Process VBECS workload collection
- +1 NEW ZTIO,ZTRTN,ZTDTH
- +2 IF ZTDESC="COLLECT BLOOD BANK WORKLOAD"
- SET ZTIO=""
- SET ZTRTN="LRCAPBV"
- SET ZTDTH=$HOROLOG
- SET ZTDESC="COLLECT VBECS WORKLOAD DATA"
- DO ^%ZTLOAD
- +3 LOCK +^LRD(65,"AA"):1
- IF '$TEST
- GOTO FIN
- +4 LOCK +^LRE("AA"):1
- IF '$TEST
- GOTO FIN
- +5 SET $PIECE(^LAB(69.9,1,"NITE"),"^",4)=$$NOW^XLFDT
- +6 ;S X="TRAP^LRCAPBB",@^%ZOSF("TRAP")
- INVENT ;
- +1 DO INIT
- IF '$ORDER(^LRD(65,"AA",0))
- GOTO DONOR
- DO FT
- +2 IF LRERR
- KILL ^LRD(65,"AA")
- DO DUMP
- SET ^TMP("LR WL ERRORS",LRX)="BASIC LRD(65 DATA MISSING"
- GOTO DONOR
- +3 FOR
- SET LRREC=$ORDER(^LRD(65,"AA",LRREC))
- IF LRREC=""
- QUIT
- SET LRTS=""
- Begin DoDot:1
- +4 SET LRFILE=LRREC_";LRD(65,"
- FOR
- SET LRTS=$ORDER(^LRD(65,"AA",LRREC,LRTS))
- IF LRTS=""
- QUIT
- SET LRDTTM=""
- FOR
- SET LRDTTM=$ORDER(^LRD(65,"AA",LRREC,LRTS,LRDTTM))
- IF LRDTTM=""
- QUIT
- SET LRACC=^(LRDTTM)
- Begin DoDot:2
- +5 SET LRCC=0
- FOR
- SET LRCC=$ORDER(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC))
- IF LRCC<1
- QUIT
- Begin DoDot:3
- +6 ; LRRRL3 is the log in person, LRRRL4 is location type
- +7 ;S $P(^LAB(69.9,1,"NITE"),U,4)=LRREC_"99 "_LRTS_","_LRDTTM_","_LRCC
- +8 SET LRX=$GET(^LRD(65,LRREC,99,LRTS,1,LRDTTM,0))
- SET LRRRL3=$PIECE(LRX,U,2)
- SET LRIN=$PIECE(LRX,U,3)
- SET (LRAA,LRMA)=+$PIECE(LRX,U,4)
- SET LRLSS=+$PIECE(LRX,U,5)
- IF 'LRLSS
- SET LRLSS=LRMA
- DO CHK
- +9 SET LRX=$GET(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC,0))
- SET LRCNT=+$PIECE(LRX,U,2)
- +10 IF 'LRCNT
- SET LRCNT=1
- +11 SET LRCTM=$PIECE(LRDTTM,".",2)
- SET LRCDT=$PIECE(LRDTTM,".")
- SET (LRUW,LRCWT)=1
- +12 IF $DATA(^LAM(LRCC,0))#2
- SET LRX=^(0)
- SET LRUW=$PIECE(LRX,"^",3)
- SET LRCWT=$PIECE(LRX,"^",11)
- +13 IF (LRIN="")!(LRCC="")!(LRCDT="")!(LRCTM="")!(LRTS="")
- DO DUMP
- QUIT
- +14 IF '$DATA(ZTQUEUED)
- WRITE !,"WKLD CODE "_LRCC
- +15 DO ^LRCAPV3
- +16 SET $PIECE(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC,0),"^",3)=1
- End DoDot:3
- +17 QUIT
- End DoDot:2
- KILL ^LRD(65,"AA",LRREC,LRTS,LRDTTM)
- End DoDot:1
- DONOR ;
- +1 IF '$ORDER(^LRE("AA",0))
- GOTO FIN
- +2 SET LRERR=0
- SET LRREC=""
- DO FT2
- +3 IF LRERR
- KILL ^LRE("AA")
- DO DUMP
- SET ^TMP("LR WL ERRORS",LRX)="BASIC LRE( DATA MISSING"
- GOTO FIN
- +4 FOR
- SET LRREC=$ORDER(^LRE("AA",LRREC))
- IF LRREC=""
- QUIT
- SET LRI=""
- SET LRFILE=LRREC_";LRE("
- FOR
- SET LRI=$ORDER(^LRE("AA",LRREC,LRI))
- IF LRI=""
- QUIT
- SET LRTS=""
- FOR
- SET LRTS=$ORDER(^LRE("AA",LRREC,LRI,LRTS))
- IF LRTS=""
- QUIT
- Begin DoDot:1
- +5 SET LRDTTM=""
- FOR LRDTTM=$ORDER(^LRE("AA",LRREC,LRI,LRTS,LRDTTM))
- IF LRDTTM=""
- QUIT
- SET LRACC=^(LRDTTM)
- Begin DoDot:2
- +6 IF '$DATA(ZTQUEUED)
- WRITE !?5,"DONOR "_LRDTTM
- +7 SET LRCC=0
- FOR
- SET LRCC=$ORDER(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,1,LRCC))
- IF LRCC<1
- QUIT
- Begin DoDot:3
- +8 ; LRRRL3 is the log in person, LRRRL4 is location type
- +9 ;S $P(^LAB(69.9,1,"NITE"),U,4)=LRREC_"5 "_LRI_"99 "_LRTS_","_LRDTTM_","_LRCC
- +10 SET LRX=$GET(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,0))
- SET LRRRL3=$PIECE(LRX,U,2)
- +11 SET LRX=$GET(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,1,LRCC,0))
- SET LRCNT=+$PIECE(LRX,U,2)
- +12 IF 'LRCNT
- SET LRCNT=1
- +13 SET LRCTM=$PIECE(LRDTTM,".",2)
- SET LRCDT=$PIECE(LRDTTM,".")
- SET (LRWU,LRCWT)=1
- +14 IF $DATA(^LAM(LRCC,0))#2
- SET LRX=^(0)
- SET LRUW=$PIECE(LRX,"^",3)
- SET LRCWT=$PIECE(LRX,"^",11)
- +15 IF (LRIN="")!(LRCC="")!(LRCDT="")!(LRCTM="")!(LRTS="")
- DO DUMP
- QUIT
- +16 DO ^LRCAPV3
- +17 SET $PIECE(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,1,LRCC,0),"^",3)=1
- End DoDot:3
- KILL ^LRE("AA",LRREC,LRI,LRTS,LRDTTM)
- +18 QUIT
- End DoDot:2
- End DoDot:1
- FIN SET $PIECE(^LAB(69.9,1,"NITE"),"^",4)=""
- LOCK -^LRD(65,"AA")
- LOCK -^LRE("AA")
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 DO CLEAN
- +3 QUIT
- FT ;
- +1 SET LRX=$GET(^LAB(69.9,1,8.1,+$GET(^LAB(69.9,1,10)),0))
- SET LRIN=$PIECE(LRX,U)
- SET (LRAA,LRMA)=+$PIECE(LRX,U,2)
- SET LRLSS=+$PIECE(LRX,U,3)
- IF 'LRLSS
- SET LRLSS=LRMA
- DO CHK
- +2 QUIT
- FT2 ;
- +1 SET LRX=$GET(^LAB(69.9,1,8.1,+$GET(^LAB(69.9,1,10)),0))
- SET LRIN=$PIECE(LRX,U)
- SET (LRAA,LRMA)=+$PIECE(LRX,U,4)
- SET LRLSS=+$PIECE(LRX,U,5)
- IF 'LRLSS
- SET LRLSS=LRMA
- DO CHK
- +2 QUIT
- CHK SET LRERR=$SELECT('LRIN:1,'LRMA:1,1:0)
- IF LRERR
- QUIT
- +1 IF '$DATA(^LRO(68,LRMA,0))#2
- SET LRERR=1
- IF LRERR
- QUIT
- SET LRX=^(0)
- IF '$PIECE(LRX,U,16)
- SET LRERR=1
- QUIT
- +2 IF 'LRLSS
- SET LRLSS=LRMA
- SET LRWA=LRLSS
- +3 SET LRLD=$SELECT($LENGTH($PIECE(LRX,U,19)):$PIECE(LRX,U,19),1:"CP")
- +4 QUIT
- DUMP ;
- +1 SET LRX=$SELECT($DATA(^TMP("LR WL ERRORS",0))#2:$PIECE(^(0),U,3),1:0)+1
- SET ^TMP("LR WL ERRORS",0)=U_U_LRX
- +2 SET LRESTR="BLOOD BANK RECORD= "_$SELECT($DATA(LRREC):LRREC,1:"")_" TS= "_$SELECT($DATA(LRTS):LRTS,1:"")_" CC= "_$SELECT($DATA(LRCC):LRCC,1:"")_" IN= "_$SELECT($DATA(LRIN):LRIN,1:"")
- +3 SET LRESTR=LRESTR_" CDT= "_$SELECT($DATA(LRCDT):LRCDT,1:"")_" CT= "_$SELECT($DATA(LRCTM):LRCTM,1:"")
- +4 SET ^TMP("LR WL ERRORS",LRX,$HOROLOG)=LRESTR
- +5 QUIT
- CLEAN ;
- +1 IF $DATA(TEST)
- QUIT
- KILL LRACC,LRAD,LRCC,LRDTTM,LRCDT,LRCNT,LRCTM,LRFILE,LRIDT,LRIN,LRLSS,LRMA
- +2 KILL LROAD,LROL,LRRREC,LRRRL,LRTEC,LRTS,LRUG,LRX,LRZCNT,LRERR,LRQC,LRII
- +3 KILL LRNT,LRCWT,LRREC,LRUW,X,LRESTR,LRWA,%,LRLD,LROAD1,LROAD2,LRRRL1
- +4 KILL LRRRL2,LRRRL3,LRRRL4,LRI,LRFIRST,LRFNUM,LREND
- +5 QUIT
- INIT ;
- +1 ; These variables are needed by LRCAPV3
- SET (LRREC,LRTS,LRACC,LROAD,LROAD1,LROAD2,LRRRL,LRRRL1,LRRRL2,LRRRL3,LROL,LRII,LRIDT,LRTEC,LRFNUM,LRERR)=""
- SET LRRRL4="Z"
- SET LRUG=50
- +2 QUIT
- TRAP ;
- +1 SET LREND=1
- IF $DATA(^LAB(69.9,1,"NITE"))
- SET $PIECE(^LAB(69.9,1,"NITE"),U,4)="ERROR"_$PIECE(^("NITE"),"^",4)
- DO @^%ZOSF("ERRTN")
- +2 QUIT
