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