| [613] | 1 | LRX ;SLC/BA/DALISC/FHS - UTILITY ROUTINES -- PREVIOUSLY ^LAB("X","...") ;1/26/07 18:36
|
|---|
| 2 | ;;5.2;LAB SERVICE;**65,153,201,217,290,360,350**;Sep 27, 1994;Build 10
|
|---|
| 3 | PT ;patient info
|
|---|
| 4 | ;
|
|---|
| 5 | N X,I,N,Y
|
|---|
| 6 | D KVAR^VADPT
|
|---|
| 7 | K LRTREA,LRWRD,AGE S (AGE,PNM,SEX,DOB,DOD,SSN,VA200,LRWRD,LRRB,LRTREA,VA("PID"),VA("BID"))=""
|
|---|
| 8 | I $G(LRDFN),'$G(LRDPF),$G(^LR(LRDFN,0)) S LRDPF=$P(^(0),U,2),DFN=$P(^(0),U,3)
|
|---|
| 9 | S LREND=0 S:$G(DFN)<1!('$G(LRDPF)) LREND=1 Q:$G(LREND)
|
|---|
| 10 | I +$G(LRDPF)'=2 D
|
|---|
| 11 | . S X=$$GET1^DID(1,+LRDPF,"","GLOBAL NAME","ANS","ANS1")
|
|---|
| 12 | . S X=X_DFN_",0)",X=$S($D(@X):@X,1:""),LRWRD=$S($D(^(.1)):$P(^(.1),U),1:0),LRRB=$S($D(^(.101)):$P(^(.101),U),1:""),DOD=$S($D(^(.35)):$P(^(.35),U),1:"")
|
|---|
| 13 | . S PNM=$P(X,U),SSN=$P(X,U,9) Q:+$G(LRDPF)=62.3
|
|---|
| 14 | . S SEX=$P(X,U,2),SEX=$S(SEX="":"M",1:SEX)
|
|---|
| 15 | . S DOB=$P(X,U,3)
|
|---|
| 16 | . S AGE=$S($D(DT)&(DOB?1(7N,7N1".".6N)):DT-DOB\10000,1:"??")
|
|---|
| 17 | . S AGE(2)=$$AGE2(DOB,$G(LRCDT)) ;Age of the patient when the specimen was collected (default =99Yr if no valid DOB present)
|
|---|
| 18 | . ;Default for LRCDT (collection date) is DT
|
|---|
| 19 | I +$G(LRDPF)=2 D
|
|---|
| 20 | . N I,X,N,Y
|
|---|
| 21 | . D OERR^VADPT D:'VAERR
|
|---|
| 22 | . . S PNM=VADM(1)
|
|---|
| 23 | . . S SEX=$P(VADM(5),U),DOB=$P(VADM(3),U),DOD=$P(VADM(6),U)
|
|---|
| 24 | . . S AGE=VADM(4),AGE(2)=$$AGE2(DOB,$G(LRCDT))
|
|---|
| 25 | . . ; S SSN=$P(VADM(2),U),LRWRD=$P(VAIN(4),U,2)
|
|---|
| 26 | . . S SSN=VA("PID"),LRWRD=$P(VAIN(4),U,2) ; for VOE
|
|---|
| 27 | . . S LRWRD(1)=+VAIN(4),LRRB=VAIN(5),LRPRAC=+VAIN(2)
|
|---|
| 28 | . . S:VAIN(3) LRTREA=+VAIN(3)
|
|---|
| 29 | D SSNFM^LRU
|
|---|
| 30 | Q
|
|---|
| 31 | DEM ;Call DEM^VADPT instead of OERR used above
|
|---|
| 32 | N X,I,N,Y
|
|---|
| 33 | D KVAR^VADPT
|
|---|
| 34 | K LRTREA,LRWRD,AGE S (AGE,PNM,SEX,DOB,SSN,VA200,LRWRD,LRRB,LRTREA,VA("PID"),VA("BID"))=""
|
|---|
| 35 | I $G(LRDFN),'$G(LRDPF),$G(^LR(LRDFN,0)) S LRDPF=$P(^(0),U,2),DFN=$P(^(0),U,3)
|
|---|
| 36 | S LREND=0 S:$G(DFN)<1!('$G(LRDPF)) LREND=1 Q:$G(LREND)
|
|---|
| 37 | I +$G(LRDPF)'=2 D
|
|---|
| 38 | . S X=^DIC(+LRDPF,0,"GL")_DFN_",0)",X=$S($D(@X):@X,1:""),LRWRD=$S($D(^(.1)):$P(^(.1),U),1:0),LRRB=$S($D(^(.101)):$P(^(.101),U),1:"")
|
|---|
| 39 | . S PNM=$P(X,U),SEX=$P(X,U,2),SEX=$S(SEX="":"M",1:SEX),DOB=$P(X,U,3)
|
|---|
| 40 | . S AGE=$S($D(DT)&(DOB?1(7N,7N1".".6N)):DT-DOB\10000,1:"??")
|
|---|
| 41 | . S AGE(2)=$$AGE2(DOB,$G(LRCDT))
|
|---|
| 42 | . S SSN=$P(X,U,9)
|
|---|
| 43 | I +$G(LRDPF)=2 N I,X,N,Y D
|
|---|
| 44 | . D DEM^VADPT D:'VAERR
|
|---|
| 45 | . . S PNM=VADM(1),SEX=$P(VADM(5),U)
|
|---|
| 46 | . . ; S DOB=$P(VADM(3),U),SSN=$P(VADM(2),U)
|
|---|
| 47 | . . S DOB=$P(VADM(3),U),SSN=VA("PID") ; for VOE
|
|---|
| 48 | . . S AGE=VADM(4),AGE(2)=$$AGE2(DOB,$G(LRCDT))
|
|---|
| 49 | D SSNFM^LRU
|
|---|
| 50 | Q
|
|---|
| 51 | DD ;date/time format
|
|---|
| 52 | S Y=$$FMTE^XLFDT(Y,"5Z")
|
|---|
| 53 | S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)
|
|---|
| 54 | Q
|
|---|
| 55 | DDOLD ;OLD
|
|---|
| 56 | I $E(Y,4,7)="0000" S Y=$S($E(Y)=2:"19"_$E(Y,2,3),1:"20"_$E(Y,2,3)) Q
|
|---|
| 57 | S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_$S(Y#1:" "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),1:"")
|
|---|
| 58 | Q
|
|---|
| 59 | DT ;current date format is LRDT0
|
|---|
| 60 | N X,DIK,DIC,%I,DICS,%DT
|
|---|
| 61 | D DT^DICRW
|
|---|
| 62 | S Y=$$FMTE^XLFDT(DT,"5D")
|
|---|
| 63 | S LRDT0=Y
|
|---|
| 64 | Q
|
|---|
| 65 | DTOLD ;2-DIGIT
|
|---|
| 66 | ;current date format is LRDT0
|
|---|
| 67 | N X,DIK,DIC,%I,DICS,%DT
|
|---|
| 68 | D DT^DICRW
|
|---|
| 69 | S Y=$P(DT,".") D DDOLD S LRDTO=Y
|
|---|
| 70 | Q
|
|---|
| 71 | DASH ;line of dashes
|
|---|
| 72 | W !,$E("--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------",1,IOM-1)
|
|---|
| 73 | Q
|
|---|
| 74 | EQUALS ;line of equals
|
|---|
| 75 | W !,$E("====================================================================================================================================================================================================================",1,IOM-1)
|
|---|
| 76 | Q
|
|---|
| 77 | DUZ ;user info
|
|---|
| 78 | S (LRUSNM,LRUSI)="" Q:'$D(X) Q:'$D(^VA(200,+X,0)) S LRUSNM=$P(^(0),"^"),LRUSI=$P(^(0),"^",2)
|
|---|
| 79 | Q
|
|---|
| 80 | DOC ;provider info
|
|---|
| 81 | I $L(X),'X S LRDOC=X Q
|
|---|
| 82 | S LRDOC=$P($G(^VA(200,+X,0)),U)
|
|---|
| 83 | S:LRDOC="" LRDOC="Unknown"
|
|---|
| 84 | Q
|
|---|
| 85 | PRAC(X) ;prac info
|
|---|
| 86 | N Y
|
|---|
| 87 | I $L(X),'X Q X
|
|---|
| 88 | S Y=$P($G(^VA(200,+X,0)),U)
|
|---|
| 89 | S:Y="" Y="Unknown"
|
|---|
| 90 | Q Y
|
|---|
| 91 | YMD ;year/month/date
|
|---|
| 92 | S %=%H>21549+%H-.1,%Y=%\365.25+141,%=%#365.25\1,%D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1,X=%Y_"00"+%M_"00"+%D K %Y,%D,%M,%
|
|---|
| 93 | Q
|
|---|
| 94 | STAMP ;time stamp
|
|---|
| 95 | S X="N",%DT="ET" D ^%DT
|
|---|
| 96 | Q
|
|---|
| 97 | KEYCOM ;key to result flags
|
|---|
| 98 | D EQUALS W !!," ------------------------------ COMMENTS ------------------------------",!," Key: 'L' = reference Low, 'H' = reference Hi, '*' = critical range"
|
|---|
| 99 | Q
|
|---|
| 100 | URG ;urgencys
|
|---|
| 101 | K LRURG S LRURG(0)="ROUTINE" S I=0 F S I=$O(^LAB(62.05,I)) Q:I<1 I $D(^(I,0)) S:'$P(^(0),U,3) LRURG(I)=$P(^(0),U)
|
|---|
| 102 | Q
|
|---|
| 103 | ADD ;date format
|
|---|
| 104 | S Y=$E("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",$E(Y,4,5)*3-2,$E(Y,4,5)*3)_" "_$S(Y#100:$J(Y#100\1,2)_", ",1:"")_(Y\10000+1700)_$S(Y#1:" "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),1:"")
|
|---|
| 105 | Q
|
|---|
| 106 | INF ;Display Infectious Warning
|
|---|
| 107 | I $L($G(IO)),$D(^LR(LRDFN,.091)),$L(^(.091)),'$G(LRQUIET) W !,$C(7)," Pat Info: ",^(.091) Q
|
|---|
| 108 | Q
|
|---|
| 109 | LRGLIN ;
|
|---|
| 110 | N HZ
|
|---|
| 111 | D GSET^%ZISS W IOG1
|
|---|
| 112 | F HZ=1:1:79 W IOHL
|
|---|
| 113 | W IOG0 D GKILL^%ZISS
|
|---|
| 114 | W !
|
|---|
| 115 | Q
|
|---|
| 116 | LRUID(LRAA,LRAD,LRAN) ;Extrinsic function call to create a unique
|
|---|
| 117 | ;accession identifier for an accession number. See description
|
|---|
| 118 | ;of field .092 in file 68 for a full explanation of this number.
|
|---|
| 119 | ;This function returns a value equal to the unique ID generated.
|
|---|
| 120 | ;LRAA=ien in file 68, accession area
|
|---|
| 121 | ;LRAD=ien for accession date in field 68.01
|
|---|
| 122 | ;LRAN=ien for accession number in field 68.02
|
|---|
| 123 | Q:$S('$G(LRAA):1,'$D(^LRO(68,LRAA,.4)):1,1:0) 0
|
|---|
| 124 | N DA,DIE,DLAYGO,DR,LRMNTH,LRUID,LRQTR,LRTYPE,LRYR1,LRYR2,LRJUL
|
|---|
| 125 | S LRUID=$P($G(^LRO(68,LRAA,.4)),"^") ;start building LRUID
|
|---|
| 126 | S:$L(LRUID)'=2 LRUID="0"_LRUID
|
|---|
| 127 | S LRTYPE=$P($G(^LRO(68,LRAA,0)),"^",3)
|
|---|
| 128 | S LRYR1=$E(LRAD,3)
|
|---|
| 129 | S LRYR2=$E(LRAD,2,3)
|
|---|
| 130 | S LRMNTH=$E(LRAD,4,5)
|
|---|
| 131 | S LRQTR=0_(LRMNTH\3.1+1)
|
|---|
| 132 | I "DW"[LRTYPE D
|
|---|
| 133 | . S X1=LRAD,X2=$E(LRAD,1,3)_"0101" D ^%DTC
|
|---|
| 134 | . S X=X+1,LRJUL=$E("000",1,3-$L(X))_X
|
|---|
| 135 | . S LRUID=LRUID_LRYR1_LRJUL
|
|---|
| 136 | . S LRUID=LRUID_$E("0000",1,4-$L(LRAN))_LRAN
|
|---|
| 137 | I LRTYPE="Y" D
|
|---|
| 138 | . S LRUID=LRUID_LRYR2_$E("000000",1,6-$L(LRAN))_LRAN
|
|---|
| 139 | I LRTYPE="Q" D
|
|---|
| 140 | . S LRUID=LRUID_LRYR1_LRQTR
|
|---|
| 141 | . S LRUID=LRUID_$E("00000",1,5-$L(LRAN))_LRAN
|
|---|
| 142 | I LRTYPE="M" D
|
|---|
| 143 | . S LRUID=LRUID_LRYR1_LRMNTH_$E("00000",1,5-$L(LRAN))_LRAN
|
|---|
| 144 | L +^LRO(68,"C"):99999
|
|---|
| 145 | I $D(^LRO(68,"C",LRUID)),'$D(^LRO(68,"C",LRUID,LRAA,LRAD,LRAN)) D
|
|---|
| 146 | . N X
|
|---|
| 147 | . S X=$E(LRUID,3,10)
|
|---|
| 148 | . F S LRUID="00"_X Q:'$D(^LRO(68,"C",LRUID)) S X=X+1 S:X>99999999 X=11111111
|
|---|
| 149 | ;The following fields are also set in rtn LROLOVER
|
|---|
| 150 | SET3 I $G(LRORDRR)'="R" S DR="16////"_LRUID
|
|---|
| 151 | I $G(LRORDRR)="R" D
|
|---|
| 152 | . S DR=";16.1////"_+$G(LRRSITE("RSITE"))_";16.2////"_+$G(LRRSITE("RPSITE"))_";16.3////"_LRUID_";16.4////"_LRSD("RUID")
|
|---|
| 153 | . I '$G(LRRSITE("IDTYPE")),'$D(^LRO(68,"C",LRSD("RUID"))) S LRUID=LRSD("RUID") ; Use sender's UID, unless previously used.
|
|---|
| 154 | . S DR="16////"_LRUID_DR
|
|---|
| 155 | S DA=LRAN,DA(1)=LRAD,DA(2)=LRAA,DIE="^LRO(68,"_DA(2)_",1,"_DA(1)_",1,",DLAYGO=68
|
|---|
| 156 | D ^DIE
|
|---|
| 157 | L -^LRO(68,"C")
|
|---|
| 158 | S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
|
|---|
| 159 | Q LRUID
|
|---|
| 160 | ;
|
|---|
| 161 | KVAR ;Kill laboratory/VADPT patient demographics
|
|---|
| 162 | K LRTREA,LRWRD,PNM,SEX,DOB,DOD,SSN,LRWRD,LRRB,LRTREA,VA,LRDFN,LRDPF,LREND,VAERR
|
|---|
| 163 | D KVA^VADPT
|
|---|
| 164 | Q
|
|---|
| 165 | ADDPT ;Returns VAPA( Patient data
|
|---|
| 166 | N X,I,N,Y D ADD^VADPT Q
|
|---|
| 167 | OPDPT ;Returns VAPD( Patient data
|
|---|
| 168 | N X,I,N,Y D OPD^VADPT Q
|
|---|
| 169 | SVCPT ;Returns VASV( Patient data
|
|---|
| 170 | N X,I,N,Y D SVC^VADPT Q
|
|---|
| 171 | OADPT ;Returns VAOA( Patient data
|
|---|
| 172 | N X,I,N,Y D OAD^VADPT Q
|
|---|
| 173 | INPPT ;Returns VAIN( Patient data
|
|---|
| 174 | N X,I,N,Y D INP^VADPT Q
|
|---|
| 175 | IN5PT ;Returns VAIP( Patient data
|
|---|
| 176 | N X,I,N,Y D IN5^VADPT Q
|
|---|
| 177 | PIDPT ;Returns VA("PID") and VA("BID") Patient Identifier
|
|---|
| 178 | N X,I,N,Y D PID^VADPT Q
|
|---|
| 179 | ;
|
|---|
| 180 | ;
|
|---|
| 181 | QUIT
|
|---|
| 182 | Y2K(X,LRYR) ; --> used to convert 2digit year to 4digit century and year
|
|---|
| 183 | ; 1/1/91 TO 1/1/1991
|
|---|
| 184 | ;
|
|---|
| 185 | ;S X=$P(X,".") ;--> Date only. Not time
|
|---|
| 186 | S LRYR=$G(LRYR,"5S")
|
|---|
| 187 | N YR
|
|---|
| 188 | S Y=$$FMTE^XLFDT(X,LRYR)
|
|---|
| 189 | I $L($P(Y,"/"))=1 S $P(Y,"/")="0"_$P(Y,"/") ;--> pad for 2digit day
|
|---|
| 190 | I $L($P(Y,"/",2))=1 S $P(Y,"/",2)="0"_$P(Y,"/",2) ;--> for 2digit month
|
|---|
| 191 | Q Y
|
|---|
| 192 | ;
|
|---|
| 193 | QUIT
|
|---|
| 194 | RD ;DIR read
|
|---|
| 195 | N Y,X
|
|---|
| 196 | K LRANSY,LRANSX
|
|---|
| 197 | S LREND=0 W !
|
|---|
| 198 | D ^DIR I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S LREND=1
|
|---|
| 199 | S LRANSY=$G(Y),LRANSX=$G(X)
|
|---|
| 200 | Q
|
|---|
| 201 | AGE2(DOB,LRCDT) ;Entry point if passing only a valid Date without patient
|
|---|
| 202 | ; DOB, LRCDT must be defined in VA FileManager internal format
|
|---|
| 203 | ; Date error will return 99yr
|
|---|
| 204 | N X,Y,%DT
|
|---|
| 205 | I '$G(LRCDT) S LRCDT=$$DT^XLFDT
|
|---|
| 206 | I '$G(DOB) Q "99yr" ;no DOB passed
|
|---|
| 207 | S DOB=$P(DOB,".")
|
|---|
| 208 | S X=DOB,LRCDT=$P(LRCDT,".")
|
|---|
| 209 | I $S(DOB'=+DOB:1,LRCDT'=+LRCDT:1,1:0) Q "99yr"
|
|---|
| 210 | I $S(DOB'?7N.NE:1,LRCDT'?7N.NE:1,1:0) Q "99yr"
|
|---|
| 211 | D ^%DT I Y'>0 Q "99yr" ;invalid date
|
|---|
| 212 | S X=LRCDT
|
|---|
| 213 | K %DT D ^%DT I Y'>0 Q "99yr" ;invalid date
|
|---|
| 214 | ;
|
|---|
| 215 | CALC ;Calculate timeframe based on difference between DOB and collection
|
|---|
| 216 | ; date. Time is stripped off.
|
|---|
| 217 | ; .0001-24 hour = dy
|
|---|
| 218 | ; 0-29 days = dy
|
|---|
| 219 | ; 30-730 dy = mo
|
|---|
| 220 | ; >24 mo = yr
|
|---|
| 221 | ;
|
|---|
| 222 | I DOB>LRCDT Q "99yr" ;DOB in future
|
|---|
| 223 | I DOB=LRCDT Q "1dy" ;same dates---pass 1 day old
|
|---|
| 224 | S X=$E(LRCDT,1,3)-$E(DOB,1,3)-($E(LRCDT,4,7)<$E(DOB,4,7))
|
|---|
| 225 | I X>1 S X=+X_"yr" Q X ;age 2 years or more---pass in years
|
|---|
| 226 | S X=$$FMDIFF^XLFDT(LRCDT,DOB,1)
|
|---|
| 227 | I X>30 S X=X\30_"mo" Q X ;over 30 days---pass in months
|
|---|
| 228 | E S X=X_"dy" Q X ;under 31 days---pass in days
|
|---|
| 229 | Q "99yr"
|
|---|
