source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRCAPBB.m@ 636

LRCAPBB ;SLC/AM/DALISC/FHS/CYM - STORE WORKLOAD FROM 65,65.5 INTO ^LRO(64.1 ;4/3/96
 ;;5.2;LAB SERVICE;**72,201**;Sep 27, 1994
EN ;
 Q:'$P($G(^LAB(69.9,1,0)),U,14)
 S:'$D(^LAB(69.9,1,"NITE")) ^("NITE")=""
 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