| [623] | 1 | ORWDLR32 ; SLC/KCM/REV/JDL - Lab Calls 6/28/2002
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,141,215,250**;Dec 17, 1997;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | ; DBIA 2263 GETLST^XPAR ^TMP($J,"WC")
|
|---|
| 5 | ;
|
|---|
| 6 | DEF(LST,ALOC,ADIV) ; procedure
|
|---|
| 7 | ; For Event Delay Order
|
|---|
| 8 | ; ALOC: Delay Event's default location
|
|---|
| 9 | ; ADIV: Delay Event's default division
|
|---|
| 10 | ; get dialog definition specific to lab
|
|---|
| 11 | S ILST=0
|
|---|
| 12 | S LST($$NXT)="~ShortList" D SHORT
|
|---|
| 13 | S LST($$NXT)="~Lab Collection Times" D LCOLLTM
|
|---|
| 14 | S LST($$NXT)="~Ward Collection Times" D WCOLLTM
|
|---|
| 15 | S LST($$NXT)="~Send Patient Times" D SENDTM
|
|---|
| 16 | S LST($$NXT)="~Collection Types" D COLLTYP
|
|---|
| 17 | S LST($$NXT)="~Default Urgency" D URGENCY
|
|---|
| 18 | S LST($$NXT)="~Schedules" D SCHED
|
|---|
| 19 | S LST($$NXT)="~Common" D COMMON
|
|---|
| 20 | Q
|
|---|
| 21 | SHORT ; from DEF, get short list of lab quick orders
|
|---|
| 22 | N I,ORTMP,ORDG,A
|
|---|
| 23 | S I=$O(^ORD(100.98,"B","LAB",0)) ; get IEN of parent lab
|
|---|
| 24 | D DG^ORCHANG1(I,"BILD",.ORDG) ; find members groups for parent lab
|
|---|
| 25 | S I=0
|
|---|
| 26 | F S I=$O(ORDG(I)) Q:'I D ; loop through list of members groups
|
|---|
| 27 | . D GETQLST^ORWDXQ(.ORTMP,I,"Q") ;get quick order of each members groups
|
|---|
| 28 | . S A=0 F S A=$O(ORTMP(A)) Q:'A D ; loop through returned quick orders and
|
|---|
| 29 | . . S LST($$NXT)="i"_ORTMP(A) ; move quick orders to display list
|
|---|
| 30 | . K ORTMP ; clean up for next members groups of quick orders
|
|---|
| 31 | Q
|
|---|
| 32 | LCOLLTM ; get collection times
|
|---|
| 33 | N TDAY,TMRW,IGNOR,CNT,ICTM,ORCTM,DOW,AMPM,DAY,TIME,TXDT
|
|---|
| 34 | S TDAY=DT,TDAY("DOW")=$H#7,TDAY("H")=$H,TDAY("TX")="T"
|
|---|
| 35 | M TMRW=TDAY D INCDATE(.TMRW)
|
|---|
| 36 | I $G(ALOC),'$$GET^XPAR(ALOC_";SC(","LR EXCEPTED LOCATIONS",1,"Q") D
|
|---|
| 37 | . S IGNOR=$$GET^XPAR("ALL","LR IGNORE HOLIDAYS",1,"Q")
|
|---|
| 38 | . S DOW(0)=$$GET^XPAR("ALL","LR COLLECT THURSDAY",1,"Q")
|
|---|
| 39 | . S DOW(1)=$$GET^XPAR("ALL","LR COLLECT FRIDAY",1,"Q")
|
|---|
| 40 | . S DOW(2)=$$GET^XPAR("ALL","LR COLLECT SATURDAY",1,"Q")
|
|---|
| 41 | . S DOW(3)=$$GET^XPAR("ALL","LR COLLECT SUNDAY",1,"Q")
|
|---|
| 42 | . S DOW(4)=$$GET^XPAR("ALL","LR COLLECT MONDAY",1,"Q")
|
|---|
| 43 | . S DOW(5)=$$GET^XPAR("ALL","LR COLLECT TUESDAY",1,"Q")
|
|---|
| 44 | . S DOW(6)=$$GET^XPAR("ALL","LR COLLECT WEDNESDAY",1,"Q")
|
|---|
| 45 | . S CNT=0 F Q:(DOW(TDAY("DOW"))=1)&((IGNOR=1)!('$D(^HOLIDAY(TDAY,0)))) D Q:CNT>6
|
|---|
| 46 | . . D INCDATE(.TDAY) S CNT=CNT+1
|
|---|
| 47 | . S CNT=0 F Q:(DOW(TMRW("DOW"))=1)&((IGNOR=1)!('$D(^HOLIDAY(TMRW,0)))) D Q:CNT>6
|
|---|
| 48 | . . D INCDATE(.TMRW) S CNT=CNT+1
|
|---|
| 49 | I $G(ADIV) D GETLST^XPAR(.ORCTM,ADIV_";DIC(4,^SYS","LR PHLEBOTOMY COLLECTION","Q")
|
|---|
| 50 | E D GETLST^XPAR(.ORCTM,"ALL","LR PHLEBOTOMY COLLECTION","Q")
|
|---|
| 51 | ;S DUZ(2)=TMPDIV
|
|---|
| 52 | S LST($$NXT)="iLNEXT^Next scheduled lab collection"
|
|---|
| 53 | S ICTM=0 F S ICTM=$O(ORCTM(ICTM)) Q:'ICTM D
|
|---|
| 54 | . I $P(ORCTM(ICTM),U)>$P($H,",",2) D
|
|---|
| 55 | . . S TXDT=TDAY("TX")
|
|---|
| 56 | . . I +TDAY("H")=+$H S DAY="Today"
|
|---|
| 57 | . . I TDAY("H")-$H=1 S DAY="Tomorrow"
|
|---|
| 58 | . . I TDAY("H")-$H>1 S DAY=$$DOWNAME(TDAY("DOW"))
|
|---|
| 59 | . E D
|
|---|
| 60 | . . S TXDT=TMRW("TX")
|
|---|
| 61 | . . S DAY=$S(TMRW("H")-$H>1:$$DOWNAME(TMRW("DOW")),1:"Tomorrow")
|
|---|
| 62 | . S AMPM=$S($P(ORCTM(ICTM),U,2)>1159:"PM",1:"AM")
|
|---|
| 63 | . S TXDT=TXDT_"@"_$P(ORCTM(ICTM),"^",2)
|
|---|
| 64 | . S TIME=$P(ORCTM(ICTM),U,2),TIME=$E(TIME,1,2)_":"_$E(TIME,3,4)
|
|---|
| 65 | . S LST($$NXT)="iL"_TXDT_U_AMPM_" Collection: "_TIME_" ("_DAY_")"
|
|---|
| 66 | . S ^TMP($J,"WC",ILST)="iW"_TXDT_U_TIME_" "_AMPM_" ("_DAY_") Ward collect" ;DBIA 2263
|
|---|
| 67 | ; D NOW^%DTC
|
|---|
| 68 | ;S LST($$NXT)="iWNOW^Now (Collect on ward)"
|
|---|
| 69 | S LST($$NXT)="iLO^Future"
|
|---|
| 70 | Q
|
|---|
| 71 | WCOLLTM ; get Ward Collect times
|
|---|
| 72 | S I=""
|
|---|
| 73 | F S I=$O(^TMP($J,"WC",I)) Q:I="" D
|
|---|
| 74 | . S LST($$NXT)=^TMP($J,"WC",I)
|
|---|
| 75 | S LST($$NXT)="iWNOW^Now (Collect on ward)"
|
|---|
| 76 | ;S LST($$NXT)="iWO^Other"
|
|---|
| 77 | K ^TMP($J,"WC")
|
|---|
| 78 | Q
|
|---|
| 79 | SENDTM ; get send patient times
|
|---|
| 80 | ;N X,X1,X2
|
|---|
| 81 | S LST($$NXT)="iLT^Today"
|
|---|
| 82 | ;S X1=DT,X2=1 D C^%DTC
|
|---|
| 83 | S LST($$NXT)="iLT+1^Tomorrow"
|
|---|
| 84 | ;S LST($$NXT)="iLO^Other"
|
|---|
| 85 | Q
|
|---|
| 86 | COLLTYP ; Collection Types in effect for this division
|
|---|
| 87 | N Y S Y=""
|
|---|
| 88 | S LST($$NXT)="iLC^Lab Collect"
|
|---|
| 89 | S LST($$NXT)="iWC^Ward Collect"
|
|---|
| 90 | S LST($$NXT)="iSP^Send Patient to Lab"
|
|---|
| 91 | I +$$ON^LR7OV4(DUZ(2)) S LST($$NXT)="iI^Immediate Collect"
|
|---|
| 92 | S:$G(ALOC) Y=$$GET^XPAR("ALL^"_ALOC_";SC(","LR DEFAULT TYPE QUICK")
|
|---|
| 93 | I $L(Y) S LST($$NXT)="d"_Y
|
|---|
| 94 | Q
|
|---|
| 95 | INCDATE(ADATE) ; called from COLLTM, increments date nodes in .ADATE
|
|---|
| 96 | N X,X1,X2,%H
|
|---|
| 97 | S X1=ADATE,X2=1 D C^%DTC S ADATE=X
|
|---|
| 98 | S ADATE("H")=ADATE("H")+1
|
|---|
| 99 | S ADATE("DOW")=ADATE("H")#7
|
|---|
| 100 | S ADATE("TX")="T+"_($P(ADATE("TX"),"+",2)+1)
|
|---|
| 101 | Q
|
|---|
| 102 | DOWNAME(DOW) ; function
|
|---|
| 103 | ; Returns Day of Week name (DOW should be $H#7)
|
|---|
| 104 | I DOW=0 Q "Thursday"
|
|---|
| 105 | I DOW=1 Q "Friday"
|
|---|
| 106 | I DOW=2 Q "Saturday"
|
|---|
| 107 | I DOW=3 Q "Sunday"
|
|---|
| 108 | I DOW=4 Q "Monday"
|
|---|
| 109 | I DOW=5 Q "Tuesday"
|
|---|
| 110 | I DOW=6 Q "Wednesday"
|
|---|
| 111 | Q ""
|
|---|
| 112 | URGENCY ; return default urgency for lab
|
|---|
| 113 | N URG
|
|---|
| 114 | S URG=$$DEFURG^LR7OR3
|
|---|
| 115 | S LST($$NXT)="i"_URG_U_$P(^LAB(62.05,URG,0),U,1)
|
|---|
| 116 | S LST($$NXT)="d"_URG_U_$P(^LAB(62.05,URG,0),U,1)
|
|---|
| 117 | Q
|
|---|
| 118 | SCHED ; return list of schedules available for lab tests
|
|---|
| 119 | N X,X0,IEN
|
|---|
| 120 | S X="" F S X=$O(^PS(51.1,"APLR",X)) Q:X="" S IEN=$O(^(X,0)) I IEN D
|
|---|
| 121 | . S X0=$G(^PS(51.1,IEN,0)) Q:X0=""
|
|---|
| 122 | . I (($P(X0,U,5)="C")!($P(X0,U,5)="D")),(+$P(X0,U,3)=0) Q
|
|---|
| 123 | . S LST($$NXT)="i"_IEN_U_X_U_$P(X0,U,5)_U_$P(X0,U,3)
|
|---|
| 124 | . I X="ONE TIME" S LST($$NXT)="d"_IEN_U_X
|
|---|
| 125 | Q
|
|---|
| 126 | COMMON ; return list of commonly ordered lab tests
|
|---|
| 127 | N ORLST,IEN,I
|
|---|
| 128 | D GETLST^XPAR(.ORLST,"ALL","ORWD COMMON LAB INPT") ;DBIA 2263
|
|---|
| 129 | S I=0 F S I=$O(ORLST(I)) Q:'I D
|
|---|
| 130 | . S IEN=$P(ORLST(I),U,2)
|
|---|
| 131 | . S LST($$NXT)="i"_IEN_U_$P(^ORD(101.43,IEN,0),U,1)
|
|---|
| 132 | Q
|
|---|
| 133 | LOAD(LST,TESTID) ; procedure
|
|---|
| 134 | ; Return sample, specimen, & urgency info about a lab test
|
|---|
| 135 | N I,J,X,X1,X4,ORY,ORLABID,ILST,PARAM
|
|---|
| 136 | S ILST=0
|
|---|
| 137 | S LST($$NXT)="~Test Name"
|
|---|
| 138 | S LST($$NXT)="d"_$P(^ORD(101.43,TESTID,0),U,1),ORLABID=$P(^(0),U,2)
|
|---|
| 139 | S LST($$NXT)="~Item ID"
|
|---|
| 140 | S LST($$NXT)="d"_+ORLABID
|
|---|
| 141 | S X=$P(ORLABID,";",1),X1=$P(ORLABID,";",2)
|
|---|
| 142 | I $E(X1,1,4)="99VB" S X1=$O(^LAB(60,"B","VBECS "_$P(^ORD(101.43,TESTID,0),"^"),0)) Q:'X1 S X=X1
|
|---|
| 143 | S X4=$P($G(^LAB(60,X,0)),U,4)
|
|---|
| 144 | S LST(ILST)=LST(ILST)_U_X4
|
|---|
| 145 | I $D(^ORD(101.43,TESTID,8))>1 S LST($$NXT)="~OIMessage"
|
|---|
| 146 | S I=0 F S I=$O(^ORD(101.43,TESTID,8,I)) Q:'I S LST($$NXT)="t"_^(I,0)
|
|---|
| 147 | S TESTID=+$P(^ORD(101.43,TESTID,0),U,2)
|
|---|
| 148 | D TEST^LR7OR3(TESTID,.ORY)
|
|---|
| 149 | S PARAM="" F S PARAM=$O(ORY(PARAM)) Q:PARAM="" D
|
|---|
| 150 | . S LST($$NXT)="~"_PARAM
|
|---|
| 151 | . I PARAM="ReqCom" D
|
|---|
| 152 | . . S LST($$NXT)="d"_$G(ORY("ReqCom")) Q
|
|---|
| 153 | . I PARAM="Default CollSamp" D
|
|---|
| 154 | . . S LST($$NXT)="d"_$G(ORY("Default CollSamp")) Q
|
|---|
| 155 | . I PARAM="Unique CollSamp" D
|
|---|
| 156 | . . S LST($$NXT)="d"_$G(ORY("Unique CollSamp")) Q
|
|---|
| 157 | . I PARAM="Default Urgency" D
|
|---|
| 158 | . . S LST($$NXT)="d"_$G(ORY("Default Urgency")) Q
|
|---|
| 159 | . I PARAM="Lab CollSamp" D
|
|---|
| 160 | . . S LST($$NXT)="d"_$G(ORY("Lab CollSamp")) Q
|
|---|
| 161 | . I $D(ORY(PARAM))>1 S I=0 F S I=$O(ORY(PARAM,I)) Q:'I D
|
|---|
| 162 | . . I PARAM="Specimens" S LST($$NXT)="i"_ORY(PARAM,I) Q
|
|---|
| 163 | . . I PARAM="Urgencies" S LST($$NXT)="i"_ORY(PARAM,I) Q
|
|---|
| 164 | . . I PARAM="GenWardInstructions" S LST($$NXT)="t"_ORY(PARAM,I,0) Q
|
|---|
| 165 | . . S LST($$NXT)="i"_I_U_ORY(PARAM,I)
|
|---|
| 166 | . . I PARAM="CollSamp" D
|
|---|
| 167 | . . . I $G(ORY("Lab CollSamp")) S $P(LST(ILST),U,8)=1
|
|---|
| 168 | . . . S X=+$P(ORY(PARAM,I),U,3)
|
|---|
| 169 | . . . I X S $P(LST(ILST),U,10)=$P($G(^LAB(61,X,0)),U,1)
|
|---|
| 170 | . . I $D(ORY(PARAM,I,"WP")) S J=0 F S J=$O(ORY(PARAM,I,"WP",J)) Q:'J D
|
|---|
| 171 | . . . S LST($$NXT)="t"_ORY(PARAM,I,"WP",J,0)
|
|---|
| 172 | Q
|
|---|
| 173 | ALLSAMP(LST) ; procedure
|
|---|
| 174 | ; returns all collection samples
|
|---|
| 175 | ; n^SampIEN^SampName^SpecPtr^TubeTop^^^LabCollect^^SpecName
|
|---|
| 176 | N SMP,SPC,ILST,IEN,X,X0
|
|---|
| 177 | S ILST=0,LST($$NXT)="~CollSamp"
|
|---|
| 178 | S SMP="" F S SMP=$O(^LAB(62,"B",SMP)) Q:SMP="" D
|
|---|
| 179 | . S IEN=0 F S IEN=$O(^LAB(62,"B",SMP,IEN)) Q:'IEN D
|
|---|
| 180 | . . S X0=^LAB(62,IEN,0)
|
|---|
| 181 | . . S X="i"_U_IEN_U_SMP_U_$P(X0,U,2)_U_$P(X0,U,3)_U_U_U_$P(X0,U,7)
|
|---|
| 182 | . . I $P(X0,U,2) D
|
|---|
| 183 | . . . S $P(X,U,10)=$P(^LAB(61,+$P(X0,U,2),0),U,1)
|
|---|
| 184 | . . . S SPC($P(X,U,4))=$P(X,U,10)
|
|---|
| 185 | . . S LST($$NXT)=X
|
|---|
| 186 | S LST($$NXT)="~Specimens"
|
|---|
| 187 | S SPC=0 F S SPC=$O(SPC(SPC)) Q:'SPC S LST($$NXT)=SPC_U_SPC(SPC)
|
|---|
| 188 | Q
|
|---|
| 189 | ONESAMP(LST,IEN) ;Return data for one colelction sample
|
|---|
| 190 | ; n^SampIEN^SampName^SpecPtr^TubeTop^^^LabCollect^^SpecName
|
|---|
| 191 | N SPC,ILST,X,X0
|
|---|
| 192 | Q:+$G(IEN)=0
|
|---|
| 193 | S ILST=0,LST($$NXT)="~CollSamp"
|
|---|
| 194 | S X0=^LAB(62,IEN,0)
|
|---|
| 195 | S X="i1"_U_IEN_U_$P(X0,U,1)_U_$P(X0,U,2)_U_$P(X0,U,3)_U_U_U_$P(X0,U,7)
|
|---|
| 196 | I $P(X0,U,2) D
|
|---|
| 197 | . S $P(X,U,10)=$P(^LAB(61,+$P(X0,U,2),0),U,1)
|
|---|
| 198 | . S SPC($P(X,U,4))=$P(X,U,10)
|
|---|
| 199 | S LST($$NXT)=X
|
|---|
| 200 | S LST($$NXT)="~Specimens"
|
|---|
| 201 | S SPC=0 F S SPC=$O(SPC(SPC)) Q:'SPC S LST($$NXT)=SPC_U_SPC(SPC)
|
|---|
| 202 | Q
|
|---|
| 203 | ONESPEC(LST,IEN) ;return one specimen
|
|---|
| 204 | Q:(+$G(IEN)=0)!('$D(^LAB(61,IEN,0)))
|
|---|
| 205 | S LST=IEN_U_$P(^LAB(61,IEN,0),U,1)
|
|---|
| 206 | Q
|
|---|
| 207 | ABBSPEC(LST) ; procedure
|
|---|
| 208 | ; returns specimens with abbreviation (uses 'E' xref)
|
|---|
| 209 | N X,IEN,ILST S ILST=0
|
|---|
| 210 | S X="" F S X=$O(^LAB(61,"E",X)) Q:X="" S IEN=$O(^(X,0)) D
|
|---|
| 211 | . S LST($$NXT)=IEN_U_$P(^LAB(61,IEN,0),U,1)
|
|---|
| 212 | Q
|
|---|
| 213 | NXT() ; called by TESTINFO, increments ILST
|
|---|
| 214 | S ILST=ILST+1
|
|---|
| 215 | Q ILST
|
|---|
| 216 | ;
|
|---|
