| 1 | LRCAPBB ;SLC/AM/DALISC/FHS/CYM - STORE WORKLOAD FROM 65,65.5 INTO ^LRO(64.1 ;4/3/96
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,201**;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | Q:'$P($G(^LAB(69.9,1,0)),U,14)
|
|---|
| 5 | S:'$D(^LAB(69.9,1,"NITE")) ^("NITE")=""
|
|---|
| 6 | L +^LRD(65,"AA"):1 I '$T G FIN
|
|---|
| 7 | L +^LRE("AA"):1 I '$T G FIN
|
|---|
| 8 | S $P(^LAB(69.9,1,"NITE"),"^",4)=$$NOW^XLFDT
|
|---|
| 9 | ;S X="TRAP^LRCAPBB",@^%ZOSF("TRAP")
|
|---|
| 10 | INVENT ;
|
|---|
| 11 | D INIT G:'$O(^LRD(65,"AA",0)) DONOR D FT
|
|---|
| 12 | I LRERR K ^LRD(65,"AA") D DUMP S ^TMP("LR WL ERRORS",LRX)="BASIC LRD(65 DATA MISSING" G DONOR
|
|---|
| 13 | F S LRREC=$O(^LRD(65,"AA",LRREC)) Q:LRREC="" S LRTS="" D
|
|---|
| 14 | .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)
|
|---|
| 15 | ..S LRCC=0 F S LRCC=$O(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC)) Q:LRCC<1 D
|
|---|
| 16 | ...; LRRRL3 is the log in person, LRRRL4 is location type
|
|---|
| 17 | ...;S $P(^LAB(69.9,1,"NITE"),U,4)=LRREC_"99 "_LRTS_","_LRDTTM_","_LRCC
|
|---|
| 18 | ...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
|
|---|
| 19 | ...S LRX=$G(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC,0)),LRCNT=+$P(LRX,U,2)
|
|---|
| 20 | ...S:'LRCNT LRCNT=1
|
|---|
| 21 | ...S LRCTM=$P(LRDTTM,".",2),LRCDT=$P(LRDTTM,"."),(LRUW,LRCWT)=1
|
|---|
| 22 | ...I $D(^LAM(LRCC,0))#2 S LRX=^(0),LRUW=$P(LRX,"^",3),LRCWT=$P(LRX,"^",11)
|
|---|
| 23 | ...I (LRIN="")!(LRCC="")!(LRCDT="")!(LRCTM="")!(LRTS="") D DUMP Q
|
|---|
| 24 | ...W:'$D(ZTQUEUED) !,"WKLD CODE "_LRCC
|
|---|
| 25 | ...D ^LRCAPV3
|
|---|
| 26 | ...S $P(^LRD(65,LRREC,99,LRTS,1,LRDTTM,1,LRCC,0),"^",3)=1
|
|---|
| 27 | ..Q
|
|---|
| 28 | DONOR ;
|
|---|
| 29 | I '$O(^LRE("AA",0)) G FIN
|
|---|
| 30 | S LRERR=0,LRREC="" D FT2
|
|---|
| 31 | I LRERR K ^LRE("AA") D DUMP S ^TMP("LR WL ERRORS",LRX)="BASIC LRE( DATA MISSING" G FIN
|
|---|
| 32 | 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
|
|---|
| 33 | .S LRDTTM="" F LRDTTM=$O(^LRE("AA",LRREC,LRI,LRTS,LRDTTM)) Q:LRDTTM="" S LRACC=^(LRDTTM) D
|
|---|
| 34 | ..W:'$D(ZTQUEUED) !?5,"DONOR "_LRDTTM
|
|---|
| 35 | ..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)
|
|---|
| 36 | ...; LRRRL3 is the log in person, LRRRL4 is location type
|
|---|
| 37 | ...;S $P(^LAB(69.9,1,"NITE"),U,4)=LRREC_"5 "_LRI_"99 "_LRTS_","_LRDTTM_","_LRCC
|
|---|
| 38 | ...S LRX=$G(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,0)),LRRRL3=$P(LRX,U,2)
|
|---|
| 39 | ...S LRX=$G(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,1,LRCC,0)),LRCNT=+$P(LRX,U,2)
|
|---|
| 40 | ...S:'LRCNT LRCNT=1
|
|---|
| 41 | ...S LRCTM=$P(LRDTTM,".",2),LRCDT=$P(LRDTTM,"."),(LRWU,LRCWT)=1
|
|---|
| 42 | ...I $D(^LAM(LRCC,0))#2 S LRX=^(0),LRUW=$P(LRX,"^",3),LRCWT=$P(LRX,"^",11)
|
|---|
| 43 | ...I (LRIN="")!(LRCC="")!(LRCDT="")!(LRCTM="")!(LRTS="") D DUMP Q
|
|---|
| 44 | ...D ^LRCAPV3
|
|---|
| 45 | ...S $P(^LRE(LRREC,5,LRI,99,LRTS,1,LRDTTM,1,LRCC,0),"^",3)=1
|
|---|
| 46 | ..Q
|
|---|
| 47 | FIN S $P(^LAB(69.9,1,"NITE"),"^",4)="" L -^LRD(65,"AA") L -^LRE("AA")
|
|---|
| 48 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 49 | D CLEAN
|
|---|
| 50 | Q
|
|---|
| 51 | FT ;
|
|---|
| 52 | 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
|
|---|
| 53 | Q
|
|---|
| 54 | FT2 ;
|
|---|
| 55 | 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
|
|---|
| 56 | Q
|
|---|
| 57 | CHK S LRERR=$S('LRIN:1,'LRMA:1,1:0) Q:LRERR
|
|---|
| 58 | S:'$D(^LRO(68,LRMA,0))#2 LRERR=1 Q:LRERR S LRX=^(0) I '$P(LRX,U,16) S LRERR=1 Q
|
|---|
| 59 | S:'LRLSS LRLSS=LRMA S LRWA=LRLSS
|
|---|
| 60 | S LRLD=$S($L($P(LRX,U,19)):$P(LRX,U,19),1:"CP")
|
|---|
| 61 | Q
|
|---|
| 62 | DUMP ;
|
|---|
| 63 | 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
|
|---|
| 64 | 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:"")
|
|---|
| 65 | S LRESTR=LRESTR_" CDT= "_$S($D(LRCDT):LRCDT,1:"")_" CT= "_$S($D(LRCTM):LRCTM,1:"")
|
|---|
| 66 | S ^TMP("LR WL ERRORS",LRX,$H)=LRESTR
|
|---|
| 67 | Q
|
|---|
| 68 | CLEAN ;
|
|---|
| 69 | Q:$D(TEST) K LRACC,LRAD,LRCC,LRDTTM,LRCDT,LRCNT,LRCTM,LRFILE,LRIDT,LRIN,LRLSS,LRMA
|
|---|
| 70 | K LROAD,LROL,LRRREC,LRRRL,LRTEC,LRTS,LRUG,LRX,LRZCNT,LRERR,LRQC,LRII
|
|---|
| 71 | K LRNT,LRCWT,LRREC,LRUW,X,LRESTR,LRWA,%,LRLD,LROAD1,LROAD2,LRRRL1
|
|---|
| 72 | K LRRRL2,LRRRL3,LRRRL4,LRI,LRFIRST,LRFNUM,LREND
|
|---|
| 73 | Q
|
|---|
| 74 | INIT ;
|
|---|
| 75 | 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
|
|---|
| 76 | Q
|
|---|
| 77 | TRAP ;
|
|---|
| 78 | 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")
|
|---|
| 79 | Q
|
|---|
