- 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/ORCDLR1.m
r613 r623 1 ORCDLR1 ;SLC/MKB,JFR - Utility fcns for LR dialogs cont ;8/29/02 14:45 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,29,49,61,79,141,143,243**;Dec 17, 1997;Build 242 3 ; 4 EN ; -- Entry Action for LR OTHER LAB TESTS order dialog 5 D GETIMES S ORMAX=0 6 S:$G(ORL) ORMAX=$$GET^XPAR("LOC.`"_+ORL,"LR MAX DAYS CONTINUOUS",1,"Q") 7 Q 8 ; 9 EX ; -- Exit Action for order dialog 10 K ORTIME,ORCOLLCT,ORMAX,ORTEST,ORDIV,ORIMTIME,ORSMAX,ORSTMS,ORSCH,ORCAT 11 I $G(ORXL) S ORL=ORXL K ORXL 12 Q 13 ; 14 GETIMES ; -- Set list of routine collections into ORTIME($H)=FMtime 15 N I,X,CNT,ON K ORTIME 16 I '$D(VALIDT) D 17 . S I=$$PTR^ORCD("OR GTX START DATE/TIME"),X=$P(ORDIALOG(I,0),U,2) 18 . S X="T::ETX",$P(ORDIALOG(I,0),U,2)=X ; reset lower bound 19 S ORDIV=+$P($G(^SC(+$G(ORL),0)),U,4) S:'ORDIV ORDIV=+$G(DUZ(2)) 20 I $G(OREVENT) S ORDIV=+$$DIV^OREVNTX(OREVENT),ORXL=$G(ORL),ORL=$$LOC^OREVNTX(OREVENT) 21 D GETLST^XPAR(.ORTIME,ORDIV_";DIC(4,","LR PHLEBOTOMY COLLECTION","N") 22 S (I,CNT)=0 F S I=$O(ORTIME(I)) Q:I'>0 S CNT=CNT+1,X=$P(ORTIME(I),U),ORTIME(I)=X,ORTIME("B",+("."_X))=I ; ORTIME($H time)=0000 FM time, ORTIME("B",.0000)=$H time of cut-off 23 S ORTIME=CNT,I=$O(ORTIME(0)) S:I ORTIME("AM")=ORTIME(I) ; 1st collection 24 S I=$O(ORTIME($P($H,",",2))) S:I ORTIME("NEXT")=ORTIME(I) ;NEXT coll 25 S ON=$$ON^LR7OV4(ORDIV) D:ON SHOW^LR7OV4(ORDIV,.ORIMTIME) 26 I 'ON,'$D(VALIDT) S I=$$PTR^ORCD("OR GTX COLLECTION TYPE"),X=$P(ORDIALOG(I,0),U,2),$P(ORDIALOG(I,0),U,2)=$P(X,";",1,3) ;Remove Immed if '$$ON 27 Q 28 ; 29 DEFTIME() ; -- Returns default collection time 30 I $L($G(LRFDATE)) S EDITONLY=1 Q LRFDATE 31 I '$D(ORCOLLCT) Q "" 32 N Y S Y="" I $D(^TMP("ORECALL",$J,ORDIALOG,PROMPT)) D Q:$L(Y) Y 33 . S Y=$$RECALL^ORCD(PROMPT) 34 . I '$S(ORCOLLCT="LC":$$LABCOLL(Y),ORCOLLCT="I":$$IMMCOLL(Y),1:$$CKDATE(Y)) S Y="" Q 35 . S EDITONLY=1 36 ;I $G(ORTYPE)="Q" Q $S(ORCOLLCT="LC":"AM",1:"") 37 D LIST^ORCD:ORCOLLCT="LC"&$G(ORDIALOG(PROMPT,"LIST")) 38 D IMMTIMES:ORCOLLCT="I"&$O(ORIMTIME(0)) 39 Q $S(ORCOLLCT="LC":"NEXT",ORCOLLCT="I":$$IMMDEF,ORCOLLCT="WC":"NOW",1:"TODAY") 40 ; 41 IMMDEF() ; -- Returns immediate collect default 42 N X,Y S X=$$DEFTIME^LR7OV4(ORDIV) 43 S Y=$S($P(X,U,3):"NOW+"_$P(X,U,3)_"'",1:$P(X,U)) 44 Q Y 45 ; 46 COLLTIME ; -- Get list of common collection times 47 I ORCOLLCT="I" D:'$D(ORIMTIME) SHOW^LR7OV4(ORDIV,.ORIMTIME) 48 I ORCOLLCT'="LC" K ORDIALOG(PROMPT,"LIST") Q 49 Q:$G(ORDIALOG(PROMPT,"LIST")) Q:'$O(ORTIME(0)) 50 N I,X,CNT,NEXT,DAY,NOW S NOW=$P($H,",",2) 51 S NEXT=$O(ORTIME(NOW)),DAY=$$NEXTCOLL($S(NEXT:"T",1:"T+1")) Q:DAY="" 52 S:'NEXT!(DAY["+") NEXT=$O(ORTIME(0)) 53 S CNT=1,ORDIALOG(PROMPT,"LIST",1)="NEXT^NEXT Lab collection ("_DAY_"@"_$$TIME(ORTIME(NEXT))_")",ORDIALOG(PROMPT,"LIST","B","NEXT LAB COLLECTION")="NEXT" 54 S ORDIALOG(PROMPT,"LIST","B","AM LAB COLLECTION")="AM" 55 G:ORTIME'>1 CTMQ ; only NEXT 56 S I=NEXT F S I=$O(ORTIME(I)) Q:I'>0 S X=DAY_"@"_$$TIME(ORTIME(I)),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=X_"^Routine Lab collection ("_X_")",ORDIALOG(PROMPT,"LIST","B","ROUTINE LAB COLLECTION")=X 57 I NEXT>$O(ORTIME(0)) D ;add morning times before NEXT to T+1 58 . S DAY="T+"_(+$P(DAY,"+",2)+1),DAY=$$NEXTCOLL(DAY),I=$O(ORTIME(0)) 59 . S X=DAY_"@"_$$TIME(ORTIME("AM")),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)="AM^AM Lab collection ("_X_")" 60 . F S I=$O(ORTIME(I)) Q:(I'>0)!(I'<NEXT) S X=DAY_"@"_$$TIME(ORTIME(I)),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=X_"^Routine Lab collection ("_X_")",ORDIALOG(PROMPT,"LIST","B","ROUTINE LAB COLLECTION")=X 61 CTMQ S ORDIALOG(PROMPT,"LIST")=CNT 62 Q 63 ; 64 NEXTCOLL(START) ; -- Returns the next day that routine lab collects are done 65 N X,Y,%DT,OFFSET,ORDAYS,PARAM I '$O(ORTIME(0)) Q "" ; no Lab collect 66 S:'$D(START) START="T" S OFFSET=+$P(START,"+",2),START=$P(START,"+") 67 F ORDAYS=1:1:7 D Q:$D(X) S OFFSET=OFFSET+1 ; ck up to a week 68 . S %DT="X",X=START_$S(OFFSET:"+"_OFFSET,1:"") 69 . D ^%DT I Y'>0 K X Q 70 . I $G(ORL),$$GET^XPAR("ALL^LOC.`"_+ORL,"LR EXCEPTED LOCATIONS") Q 71 . S PARAM="LR COLLECT "_$$UP^XLFSTR($$DOW^XLFDT(Y)) 72 . I '$$GET^XPAR("ALL",PARAM) K X Q 73 . I '$$GET^XPAR("ALL","LR IGNORE HOLIDAYS"),$D(^HOLIDAY($P(Y,"."))) K X Q 74 S Y=$S($D(X):X,1:"") 75 Q Y 76 ; 77 TIME(X) ; -- Returns 00:00AM from 0000 FileMan time 78 N HOUR,MIN,XM,Y 79 S HOUR=$E(X,1,2),MIN=$E(X,3,4),XM="AM" 80 I HOUR'<12 S XM="PM" S:HOUR>12 HOUR=HOUR-12 81 S:$E(HOUR)="0" HOUR=$E(HOUR,2) ; strip leading 0 82 S Y=HOUR_":"_MIN_XM 83 Q Y 84 ; 85 LISTCOLL ; -- Lists the routine collection times for ??-help 86 I '$O(ORTIME(0)) W !,"No routine lab collection times defined." Q 87 N I,X S I=0,X="" 88 F S I=$O(ORTIME(I)) Q:I'>0 S X=X_$S($L(X):", ",1:"")_$$TIME(ORTIME(I)) 89 W !,"Routine collection times are "_X_"." 90 W !,"You may also enter AM for the morning collection, or NEXT for the next",!,"routine collection time." 91 Q 92 ; 93 IMMTIMES ; -- Show the valid date/times for immediate collect 94 N I S I=0 95 F S I=$O(ORIMTIME(I)) Q:I'>0 W !,ORIMTIME(I) 96 Q 97 ; 98 CKDATE(X) ; -- Valid coll time for SP or WC? 99 S X=$$UP^XLFSTR(X) I ("NOW"[X)!("TODAY"[X) Q 1 100 I X?1"T+"1.3N,+$P(X,"+",2)'>370 Q 1 101 N Y,%DT,D 102 I X'?7N.1".".6N S %DT="TX" D ^%DT S:Y>0 X=Y I Y'>0 Q "0^Invalid date/time" 103 S D=$P(X,".") I D<DT Q "0^Cannot order for past days" 104 I $P(X,".",2),X<$$NOW^XLFDT,'$G(OREVENT),$G(ORTYPE)'="Z" Q "0^The requested collection time has passed" 105 I D>$$FMADD^XLFDT(DT,370) Q "0^Cannot order more than 370 days in advance" 106 Q 1 107 ; 108 IMMCOLL(X) ; -- Valid immediate collection date/time? 109 I X?1"NOW+"1.N1"'" Q 1 110 I X'?7N.1".".6N N Y,%DT S %DT="T" D ^%DT S:Y>0 X=Y I Y'>0 Q "0^Invalid date/time" 111 Q $$VALID^LR7OV4(ORDIV,X) 112 ; 113 LABCOLL(ORXTIM) ; -- Valid lab collection date/time? 114 ; Returns valid flag of 1 or 0^message 115 N I,X,Y,%DT,ORD,ORT,PARAM,ORDY 116 I '$O(ORTIME(0)) Q "0^There are no lab collection times defined!" 117 I (ORXTIM="AM")!(ORXTIM="NEXT") Q 1 118 I ORXTIM'?7N.1".".6N S %DT="T",X=ORXTIM D ^%DT S:Y>0 ORXTIM=Y I Y'>0 Q "0^Invalid date/time" 119 ;I ORXTIM?1"V".E S T="."_$P(ORXTIM,"@",2) G D1 ; Visit - ignore day (D ^%DT ??) 120 S ORD=$P(ORXTIM,"."),ORT="."_$P(ORXTIM,".",2) 121 S:ORT="." ORT=+("."_$G(ORTIME("AM"))) 122 I '$D(ORTIME("B",ORT)) Q "0^Invalid lab collection time" 123 LC1 ; -- check date 124 I ORD<DT Q "0^Can not order for past days." 125 I ORXTIM<$$NOW^XLFDT,'$G(OREVENT) Q "0^Cannot order in the past" 126 I $G(ORTYPE)'="Z",'$G(OREVENT),ORD=DT,$P($H,",",2)>ORTIME("B",ORT) Q "0^The cut-off time for this collection has passed" 127 S ORDY=7 I $D(^XTV(8989.51,"B","LR LAB COLLECT FUTURE")),$G(ORL) S ORDY=+$$GET^XPAR("ALL^DIV.`"_ORDIV_"^LOC.`"_+ORL,"LR LAB COLLECT FUTURE",1,"I") 128 I ORXTIM>$$FMADD^XLFDT($$NOW^XLFDT,ORDY) Q "0^Cannot order a lab collection more than "_ORDY_" days in advance" 129 I $G(ORL),$$GET^XPAR("ALL^LOC.`"_+ORL,"LR EXCEPTED LOCATIONS") Q 1 130 S PARAM="LR COLLECT "_$$UP^XLFSTR($$DOW^XLFDT(ORD)) 131 I $G(ORTYPE)'="Z",'$$GET^XPAR("ALL",PARAM) Q "0^There are no lab collections that day" 132 I $G(ORTYPE)'="Z",'$$GET^XPAR("ALL","LR IGNORE HOLIDAYS"),$D(^HOLIDAY(ORD)) Q "0^There are no lab collections on holidays" 133 Q 1 134 ; 135 LABSAMP() ; -- Lab Collect sample? 136 N X,Y S X=+$$VAL^ORCD("COLLECTION SAMPLE"),Y=$P($G(^LAB(62,X,0)),U,7) 137 Q Y 138 ; 139 COLLTYPE() ; -- Returns default collection type 140 N Y I $G(ORTYPE)="Z" S Y="" G CTQ 141 I $L($G(LRFZX)) S Y=LRFZX,EDITONLY=1 G CTQ 142 I $D(^TMP("ORECALL",$J,+ORDIALOG,PROMPT)) D G CTQ 143 . S Y=$$RECALL^ORCD(PROMPT),EDITONLY=1 144 S:$G(ORL) Y=$$GET^XPAR("ALL^"_ORL,"LR DEFAULT TYPE QUICK") 145 I '$L($G(Y)) S Y=$S('$$INPT^ORCD:"SP",$G(ORTYPE)="Q":"LC",1:"WC") 146 CTQ I Y="I",'$O(ORIMTIME(0))!('$G(ORTEST("Lab CollSamp"))) S Y="WC" 147 I Y="LC",'$O(ORTIME(0))!('$G(ORTEST("Lab CollSamp"))) S Y="WC" 148 ;S:$G(ORTYPE)="Q" EDITONLY=1 149 I '(FIRST&EDITONLY) D HELPTYPE 150 Q Y 151 ; 152 CKTYPE ; -- Valid type for time, sample? 153 I Y="LC",'$O(ORTIME(0)) W $C(7),!,"There are no lab collection times defined!" K DONE Q 154 I Y="I",'$O(ORIMTIME(0)) W $C(7),!,"There are no immediate collection times defined!" K DONE Q 155 I (Y="LC"!(Y="I")),'$G(ORTEST("Lab CollSamp")) W $C(7),!,"There is no lab collection sample defined for this test!",! K DONE Q 156 I $D(ORESET),ORESET'=Y,("ILC"[ORESET)!("ILC"[Y) D CHANGED^ORCDLR("TYPE") K ORDIALOG($$PTR^ORCD("OR GTX LAB URGENCY"),"LIST") 157 Q 158 ; 159 HELPTYPE ; -- Xecutable help for Coll Type 160 W !!,"SEND TO LAB - Means the patient is ambulatory and will be sent to the",!,"Laboratory draw room to have blood drawn." 161 W !,"WARD COLLECT - Means that either the physician or a nurse will be collecting",!,"the sample on the ward." 162 W !,"LAB BLOOD TEAM - Means the phlebotomist from Lab will draw the blood on the",!,"ward. This method is limited to laboratory defined collection times." 163 W:$$ON^LR7OV4(ORDIV) !,"IMMEDIATE COLLECT BY BLOOD TEAM - Means the phlebotomist from Lab is on",!,"call to draw blood on the ward. This method is available during times",!,"defined by Laboratory." W ! 164 N DOMAIN S DOMAIN=$P(ORDIALOG(PROMPT,0),U,2) D SETLST1^ORCD 165 Q 166 VALID(ORDER) ;check collection time on release 167 N VALIDT,OREVENT,COLLTYPE,COLLDT,OK,ORDIV,ORTXT,ORPTLK,ORTIME,ORIMTIME,ORACT 168 S VALIDT="" D GETIMES 169 S COLLDT=$$VALUE^ORCSAVE2(ORDER,"START") 170 S COLLTYPE=$$VALUE^ORCSAVE2(ORDER,"COLLECT") 171 I $L($P(^OR(100,+ORIFN,0),U,17)) S OREVENT=$P(^(0),U,17) 172 I "NOWAMNEXT"[COLLDT D:'$G(OREVENT) MULT Q 1 ;OK 173 S OK=$S(COLLTYPE="LC":$$LABCOLL(COLLDT),COLLTYPE="I":$$IMMCOLL(COLLDT),1:$$CKDATE(COLLDT)) 174 I OK D:'$G(OREVENT) MULT Q 1 ;COLLDT passed checks 175 W !!,$C(7),$P(OK,U,2) 176 D TEXT^ORQ12(.ORTXT,ORDER) W !,$G(ORTXT(1)) K ORTXT 177 W !,"must be edited before signing/release." K VALIDT D 178 . N ORDIV,ORIMTIME,ORTIME,ORNP 179 . S ORNP=$P(^OR(100,ORDER,0),U,4) 180 . S ORACT="XX" D XX^ORCACT4 ;edit order 181 I $$VALUE^ORCSAVE2(ORDER,"START")'=COLLDT D:'$G(OREVENT) MULT Q 1 ;OK 182 Q 0 183 ; 184 MULT ; -- ck child orders 185 N CHGD S CHGD=$$MULT^ORCDLR(ORDER,COLLTYPE,COLLDT) Q:'CHGD 186 W !!,$P(CHGD,U,2) H 2 187 Q 1 ORCDLR1 ;SLC/MKB,JFR - Utility fcns for LR dialogs cont ;8/29/02 14:45 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,29,49,61,79,141**;Dec 17, 1997 3 ; 4 EN ; -- Entry Action for LR OTHER LAB TESTS order dialog 5 D GETIMES S ORMAX=0 6 S:$G(ORL) ORMAX=$$GET^XPAR("LOC.`"_+ORL,"LR MAX DAYS CONTINUOUS",1,"Q") 7 Q 8 ; 9 EX ; -- Exit Action for order dialog 10 K ORTIME,ORCOLLCT,ORMAX,ORTEST,ORDIV,ORIMTIME,ORSMAX,ORSTMS,ORSCH,ORCAT 11 I $G(ORXL) S ORL=ORXL K ORXL 12 Q 13 ; 14 GETIMES ; -- Set list of routine collections into ORTIME($H)=FMtime 15 N I,X,CNT,ON K ORTIME 16 I '$D(VALIDT) D 17 . S I=$$PTR^ORCD("OR GTX START DATE/TIME"),X=$P(ORDIALOG(I,0),U,2) 18 . S X="T::ETX",$P(ORDIALOG(I,0),U,2)=X ; reset lower bound 19 S ORDIV=+$P($G(^SC(+$G(ORL),0)),U,4) S:'ORDIV ORDIV=+$G(DUZ(2)) 20 I $G(OREVENT) S ORDIV=+$$DIV^OREVNTX(OREVENT),ORXL=$G(ORL),ORL=$$LOC^OREVNTX(OREVENT) 21 D GETLST^XPAR(.ORTIME,ORDIV_";DIC(4,","LR PHLEBOTOMY COLLECTION","N") 22 S (I,CNT)=0 F S I=$O(ORTIME(I)) Q:I'>0 S CNT=CNT+1,X=$P(ORTIME(I),U),ORTIME(I)=X,ORTIME("B",+("."_X))=I ; ORTIME($H time)=0000 FM time, ORTIME("B",.0000)=$H time of cut-off 23 S ORTIME=CNT,I=$O(ORTIME(0)) S:I ORTIME("AM")=ORTIME(I) ; 1st collection 24 S I=$O(ORTIME($P($H,",",2))) S:I ORTIME("NEXT")=ORTIME(I) ;NEXT coll 25 S ON=$$ON^LR7OV4(ORDIV) D:ON SHOW^LR7OV4(ORDIV,.ORIMTIME) 26 I 'ON,'$D(VALIDT) S I=$$PTR^ORCD("OR GTX COLLECTION TYPE"),X=$P(ORDIALOG(I,0),U,2),$P(ORDIALOG(I,0),U,2)=$P(X,";",1,3) ;Remove Immed if '$$ON 27 Q 28 ; 29 DEFTIME() ; -- Returns default collection time 30 I $L($G(LRFDATE)) S EDITONLY=1 Q LRFDATE 31 N Y S Y="" I $D(^TMP("ORECALL",$J,ORDIALOG,PROMPT)) D Q:$L(Y) Y 32 . S Y=$$RECALL^ORCD(PROMPT) 33 . I '$S(ORCOLLCT="LC":$$LABCOLL(Y),ORCOLLCT="I":$$IMMCOLL(Y),1:$$CKDATE(Y)) S Y="" Q 34 . S EDITONLY=1 35 ;I $G(ORTYPE)="Q" Q $S(ORCOLLCT="LC":"AM",1:"") 36 D LIST^ORCD:ORCOLLCT="LC"&$G(ORDIALOG(PROMPT,"LIST")) 37 D IMMTIMES:ORCOLLCT="I"&$O(ORIMTIME(0)) 38 Q $S(ORCOLLCT="LC":"NEXT",ORCOLLCT="I":$$IMMDEF,ORCOLLCT="WC":"NOW",1:"TODAY") 39 ; 40 IMMDEF() ; -- Returns immediate collect default 41 N X,Y S X=$$DEFTIME^LR7OV4(ORDIV) 42 S Y=$S($P(X,U,3):"NOW+"_$P(X,U,3)_"'",1:$P(X,U)) 43 Q Y 44 ; 45 COLLTIME ; -- Get list of common collection times 46 I ORCOLLCT="I" D:'$D(ORIMTIME) SHOW^LR7OV4(ORDIV,.ORIMTIME) 47 I ORCOLLCT'="LC" K ORDIALOG(PROMPT,"LIST") Q 48 Q:$G(ORDIALOG(PROMPT,"LIST")) Q:'$O(ORTIME(0)) 49 N I,X,CNT,NEXT,DAY,NOW S NOW=$P($H,",",2) 50 S NEXT=$O(ORTIME(NOW)),DAY=$$NEXTCOLL($S(NEXT:"T",1:"T+1")) Q:DAY="" 51 S:'NEXT!(DAY["+") NEXT=$O(ORTIME(0)) 52 S CNT=1,ORDIALOG(PROMPT,"LIST",1)="NEXT^NEXT Lab collection ("_DAY_"@"_$$TIME(ORTIME(NEXT))_")",ORDIALOG(PROMPT,"LIST","B","NEXT LAB COLLECTION")="NEXT" 53 S ORDIALOG(PROMPT,"LIST","B","AM LAB COLLECTION")="AM" 54 G:ORTIME'>1 CTMQ ; only NEXT 55 S I=NEXT F S I=$O(ORTIME(I)) Q:I'>0 S X=DAY_"@"_$$TIME(ORTIME(I)),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=X_"^Routine Lab collection ("_X_")",ORDIALOG(PROMPT,"LIST","B","ROUTINE LAB COLLECTION")=X 56 I NEXT>$O(ORTIME(0)) D ;add morning times before NEXT to T+1 57 . S DAY="T+"_(+$P(DAY,"+",2)+1),DAY=$$NEXTCOLL(DAY),I=$O(ORTIME(0)) 58 . S X=DAY_"@"_$$TIME(ORTIME("AM")),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)="AM^AM Lab collection ("_X_")" 59 . F S I=$O(ORTIME(I)) Q:(I'>0)!(I'<NEXT) S X=DAY_"@"_$$TIME(ORTIME(I)),CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=X_"^Routine Lab collection ("_X_")",ORDIALOG(PROMPT,"LIST","B","ROUTINE LAB COLLECTION")=X 60 CTMQ S ORDIALOG(PROMPT,"LIST")=CNT 61 Q 62 ; 63 NEXTCOLL(START) ; -- Returns the next day that routine lab collects are done 64 N X,Y,%DT,OFFSET,ORDAYS,PARAM I '$O(ORTIME(0)) Q "" ; no Lab collect 65 S:'$D(START) START="T" S OFFSET=+$P(START,"+",2),START=$P(START,"+") 66 F ORDAYS=1:1:7 D Q:$D(X) S OFFSET=OFFSET+1 ; ck up to a week 67 . S %DT="X",X=START_$S(OFFSET:"+"_OFFSET,1:"") 68 . D ^%DT I Y'>0 K X Q 69 . I $G(ORL),$$GET^XPAR("ALL^LOC.`"_+ORL,"LR EXCEPTED LOCATIONS") Q 70 . S PARAM="LR COLLECT "_$$UP^XLFSTR($$DOW^XLFDT(Y)) 71 . I '$$GET^XPAR("ALL",PARAM) K X Q 72 . I '$$GET^XPAR("ALL","LR IGNORE HOLIDAYS"),$D(^HOLIDAY($P(Y,"."))) K X Q 73 S Y=$S($D(X):X,1:"") 74 Q Y 75 ; 76 TIME(X) ; -- Returns 00:00AM from 0000 FileMan time 77 N HOUR,MIN,XM,Y 78 S HOUR=$E(X,1,2),MIN=$E(X,3,4),XM="AM" 79 I HOUR'<12 S XM="PM" S:HOUR>12 HOUR=HOUR-12 80 S:$E(HOUR)="0" HOUR=$E(HOUR,2) ; strip leading 0 81 S Y=HOUR_":"_MIN_XM 82 Q Y 83 ; 84 LISTCOLL ; -- Lists the routine collection times for ??-help 85 I '$O(ORTIME(0)) W !,"No routine lab collection times defined." Q 86 N I,X S I=0,X="" 87 F S I=$O(ORTIME(I)) Q:I'>0 S X=X_$S($L(X):", ",1:"")_$$TIME(ORTIME(I)) 88 W !,"Routine collection times are "_X_"." 89 W !,"You may also enter AM for the morning collection, or NEXT for the next",!,"routine collection time." 90 Q 91 ; 92 IMMTIMES ; -- Show the valid date/times for immediate collect 93 N I S I=0 94 F S I=$O(ORIMTIME(I)) Q:I'>0 W !,ORIMTIME(I) 95 Q 96 ; 97 CKDATE(X) ; -- Valid coll time for SP or WC? 98 S X=$$UP^XLFSTR(X) I ("NOW"[X)!("TODAY"[X) Q 1 99 I X?1"T+"1.3N,+$P(X,"+",2)'>370 Q 1 100 N Y,%DT,D 101 I X'?7N.1".".6N S %DT="TX" D ^%DT S:Y>0 X=Y I Y'>0 Q "0^Invalid date/time" 102 S D=$P(X,".") I D<DT Q "0^Cannot order for past days" 103 I $P(X,".",2),X<$$NOW^XLFDT,'$G(OREVENT),$G(ORTYPE)'="Z" Q "0^The requested collection time has passed" 104 I D>$$FMADD^XLFDT(DT,370) Q "0^Cannot order more than 370 days in advance" 105 Q 1 106 ; 107 IMMCOLL(X) ; -- Valid immediate collection date/time? 108 I X?1"NOW+"1.N1"'" Q 1 109 I X'?7N.1".".6N N Y,%DT S %DT="T" D ^%DT S:Y>0 X=Y I Y'>0 Q "0^Invalid date/time" 110 Q $$VALID^LR7OV4(ORDIV,X) 111 ; 112 LABCOLL(ORXTIM) ; -- Valid lab collection date/time? 113 ; Returns valid flag of 1 or 0^message 114 N I,X,Y,%DT,ORD,ORT,PARAM,ORDY 115 I '$O(ORTIME(0)) Q "0^There are no lab collection times defined!" 116 I (ORXTIM="AM")!(ORXTIM="NEXT") Q 1 117 I ORXTIM'?7N.1".".6N S %DT="T",X=ORXTIM D ^%DT S:Y>0 ORXTIM=Y I Y'>0 Q "0^Invalid date/time" 118 ;I ORXTIM?1"V".E S T="."_$P(ORXTIM,"@",2) G D1 ; Visit - ignore day (D ^%DT ??) 119 S ORD=$P(ORXTIM,"."),ORT="."_$P(ORXTIM,".",2) 120 S:ORT="." ORT=+("."_$G(ORTIME("AM"))) 121 I '$D(ORTIME("B",ORT)) Q "0^Invalid lab collection time" 122 LC1 ; -- check date 123 I ORD<DT Q "0^Can not order for past days." 124 I ORXTIM<$$NOW^XLFDT,'$G(OREVENT) Q "0^Cannot order in the past" 125 I $G(ORTYPE)'="Z",'$G(OREVENT),ORD=DT,$P($H,",",2)>ORTIME("B",ORT) Q "0^The cut-off time for this collection has passed" 126 S ORDY=7 I $D(^XTV(8989.51,"B","LR LAB COLLECT FUTURE")),$G(ORL) S ORDY=+$$GET^XPAR("ALL^DIV.`"_ORDIV_"^LOC.`"_+ORL,"LR LAB COLLECT FUTURE",1,"I") 127 I ORXTIM>$$FMADD^XLFDT($$NOW^XLFDT,ORDY) Q "0^Cannot order a lab collection more than "_ORDY_" days in advance" 128 I $G(ORL),$$GET^XPAR("ALL^LOC.`"_+ORL,"LR EXCEPTED LOCATIONS") Q 1 129 S PARAM="LR COLLECT "_$$UP^XLFSTR($$DOW^XLFDT(ORD)) 130 I $G(ORTYPE)'="Z",'$$GET^XPAR("ALL",PARAM) Q "0^There are no lab collections that day" 131 I $G(ORTYPE)'="Z",'$$GET^XPAR("ALL","LR IGNORE HOLIDAYS"),$D(^HOLIDAY(ORD)) Q "0^There are no lab collections on holidays" 132 Q 1 133 ; 134 LABSAMP() ; -- Lab Collect sample? 135 N X,Y S X=+$$VAL^ORCD("COLLECTION SAMPLE"),Y=$P($G(^LAB(62,X,0)),U,7) 136 Q Y 137 ; 138 COLLTYPE() ; -- Returns default collection type 139 N Y I $G(ORTYPE)="Z" S Y="" G CTQ 140 I $L($G(LRFZX)) S Y=LRFZX,EDITONLY=1 G CTQ 141 I $D(^TMP("ORECALL",$J,+ORDIALOG,PROMPT)) D G CTQ 142 . S Y=$$RECALL^ORCD(PROMPT),EDITONLY=1 143 S:$G(ORL) Y=$$GET^XPAR("ALL^"_ORL,"LR DEFAULT TYPE QUICK") 144 I '$L($G(Y)) S Y=$S('$$INPT^ORCD:"SP",$G(ORTYPE)="Q":"LC",1:"WC") 145 CTQ I Y="I",'$O(ORIMTIME(0))!('$G(ORTEST("Lab CollSamp"))) S Y="WC" 146 I Y="LC",'$O(ORTIME(0))!('$G(ORTEST("Lab CollSamp"))) S Y="WC" 147 ;S:$G(ORTYPE)="Q" EDITONLY=1 148 I '(FIRST&EDITONLY) D HELPTYPE 149 Q Y 150 ; 151 CKTYPE ; -- Valid type for time, sample? 152 I Y="LC",'$O(ORTIME(0)) W $C(7),!,"There are no lab collection times defined!" K DONE Q 153 I Y="I",'$O(ORIMTIME(0)) W $C(7),!,"There are no immediate collection times defined!" K DONE Q 154 I (Y="LC"!(Y="I")),'$G(ORTEST("Lab CollSamp")) W $C(7),!,"There is no lab collection sample defined for this test!",! K DONE Q 155 I $D(ORESET),ORESET'=Y,("ILC"[ORESET)!("ILC"[Y) D CHANGED^ORCDLR("TYPE") K ORDIALOG($$PTR^ORCD("OR GTX LAB URGENCY"),"LIST") 156 Q 157 ; 158 HELPTYPE ; -- Xecutable help for Coll Type 159 W !!,"SEND TO LAB - Means the patient is ambulatory and will be sent to the",!,"Laboratory draw room to have blood drawn." 160 W !,"WARD COLLECT - Means that either the physician or a nurse will be collecting",!,"the sample on the ward." 161 W !,"LAB BLOOD TEAM - Means the phlebotomist from Lab will draw the blood on the",!,"ward. This method is limited to laboratory defined collection times." 162 W:$$ON^LR7OV4(ORDIV) !,"IMMEDIATE COLLECT BY BLOOD TEAM - Means the phlebotomist from Lab is on",!,"call to draw blood on the ward. This method is available during times",!,"defined by Laboratory." W ! 163 N DOMAIN S DOMAIN=$P(ORDIALOG(PROMPT,0),U,2) D SETLST1^ORCD 164 Q 165 VALID(ORDER) ;check collection time on release 166 N VALIDT,OREVENT,COLLTYPE,COLLDT,OK,ORDIV,ORTXT,ORPTLK,ORTIME,ORIMTIME,ORACT 167 S VALIDT="" D GETIMES 168 S COLLDT=$$VALUE^ORCSAVE2(ORDER,"START") 169 S COLLTYPE=$$VALUE^ORCSAVE2(ORDER,"COLLECT") 170 I $L($P(^OR(100,+ORIFN,0),U,17)) S OREVENT=$P(^(0),U,17) 171 I "NOWAMNEXT"[COLLDT D:'$G(OREVENT) MULT Q 1 ;OK 172 S OK=$S(COLLTYPE="LC":$$LABCOLL(COLLDT),COLLTYPE="I":$$IMMCOLL(COLLDT),1:$$CKDATE(COLLDT)) 173 I OK D:'$G(OREVENT) MULT Q 1 ;COLLDT passed checks 174 W !!,$C(7),$P(OK,U,2) 175 D TEXT^ORQ12(.ORTXT,ORDER) W !,$G(ORTXT(1)) K ORTXT 176 W !,"must be edited before signing/release." K VALIDT D 177 . N ORDIV,ORIMTIME,ORTIME,ORNP 178 . S ORNP=$P(^OR(100,ORDER,0),U,4) 179 . S ORACT="XX" D XX^ORCACT4 ;edit order 180 I $$VALUE^ORCSAVE2(ORDER,"START")'=COLLDT D:'$G(OREVENT) MULT Q 1 ;OK 181 Q 0 182 ; 183 MULT ; -- ck child orders 184 N CHGD S CHGD=$$MULT^ORCDLR(ORDER,COLLTYPE,COLLDT) Q:'CHGD 185 W !!,$P(CHGD,U,2) H 2 186 Q
Note:
See TracChangeset
for help on using the changeset viewer.
