- LRUT ;AVAMC/REG - TIME DIFFERENCES ; 8/22/88 21:0 ;
- ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
- ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
- S Z=+^LRE(DA(2),5,DA(1),66,DA,0),Z(0)=$P(^LAB(66,Z,0),"^",13) Q:'Z(0)
- S Z=$P(^LRE(DA(2),5,DA(1),2),"^",3) D H S W(1)=Z(3)+Z(0) D C S C=W
- S Z=X D H S W(1)=Z(3) D C D:W>C E K W,Z,C Q
- H ;from LRBLDC,LRBLDCR
- S %Y=$E(Z,1,3),%M=$E(Z,4,5),%D=$E(Z,6,7)
- S %H=%M>2&'(%Y#4)+$P("^31^59^90^120^151^181^212^243^273^304^334","^",%M)+%D
- S %='%M!'%D,%Y=%Y-141,%H=%H+(%Y*365)+(%Y\4)-(%Y>59)+%,%Y=$S(%:-1,1:%H+4#7)
- A S Z=Z_"000",Z(1)=$E($P(Z,".",2),1,2),Z(2)=$E($P(Z,".",2),3,4) S Z(3)=Z(1)*60+Z(2)
- K %M,%D,% Q
- C ;from LRBLDC
- S W=%H+(W(1)\1440),W(1)=W(1)#1440,W(1)=$E("0000",1,4-$L(W(1)))_W(1),W=W_W(1) Q
- E W $C(7),!!,"Time between collection and storage too long !!",! K X Q
- ;
- ;Z(0)=MINUTES ALLOWED BETWEEN COLLECTION AND PREPARATION OF COMPONENT
- D ;from LRBLJD, LRBLPCS1
- S %=%H>21549+%H-.1,%Y=%\365.25+141,%=%#365.25\1 ;also called by LRBLPCS1
- S %D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1
- S X=%Y_"00"+%M_"00"+%D Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUT 1119 printed Jan 18, 2025@03:22:53 Page 2
- LRUT ;AVAMC/REG - TIME DIFFERENCES ; 8/22/88 21:0 ;
- +1 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
- +2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
- +3 SET Z=+^LRE(DA(2),5,DA(1),66,DA,0)
- SET Z(0)=$PIECE(^LAB(66,Z,0),"^",13)
- if 'Z(0)
- QUIT
- +4 SET Z=$PIECE(^LRE(DA(2),5,DA(1),2),"^",3)
- DO H
- SET W(1)=Z(3)+Z(0)
- DO C
- SET C=W
- +5 SET Z=X
- DO H
- SET W(1)=Z(3)
- DO C
- if W>C
- DO E
- KILL W,Z,C
- QUIT
- H ;from LRBLDC,LRBLDCR
- +1 SET %Y=$EXTRACT(Z,1,3)
- SET %M=$EXTRACT(Z,4,5)
- SET %D=$EXTRACT(Z,6,7)
- +2 SET %H=%M>2&'(%Y#4)+$PIECE("^31^59^90^120^151^181^212^243^273^304^334","^",%M)+%D
- +3 SET %='%M!'%D
- SET %Y=%Y-141
- SET %H=%H+(%Y*365)+(%Y\4)-(%Y>59)+%
- SET %Y=$SELECT(%:-1,1:%H+4#7)
- A SET Z=Z_"000"
- SET Z(1)=$EXTRACT($PIECE(Z,".",2),1,2)
- SET Z(2)=$EXTRACT($PIECE(Z,".",2),3,4)
- SET Z(3)=Z(1)*60+Z(2)
- +1 KILL %M,%D,%
- QUIT
- C ;from LRBLDC
- +1 SET W=%H+(W(1)\1440)
- SET W(1)=W(1)#1440
- SET W(1)=$EXTRACT("0000",1,4-$LENGTH(W(1)))_W(1)
- SET W=W_W(1)
- QUIT
- E WRITE $CHAR(7),!!,"Time between collection and storage too long !!",!
- KILL X
- QUIT
- +1 ;
- +2 ;Z(0)=MINUTES ALLOWED BETWEEN COLLECTION AND PREPARATION OF COMPONENT
- D ;from LRBLJD, LRBLPCS1
- +1 ;also called by LRBLPCS1
- SET %=%H>21549+%H-.1
- SET %Y=%\365.25+141
- SET %=%#365.25\1
- +2 SET %D=%+306#(%Y#4=0+365)#153#61#31+1
- SET %M=%-%D\29+1
- +3 SET X=%Y_"00"+%M_"00"+%D
- QUIT