| 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
|
|---|
