| 1 | ORCDLR ;SLC/MKB-Utility functions for LR dialogs ;6/11/97 11:47
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,29,49,61,71,79,175**;Dec 17, 1997
|
|---|
| 3 | TEST ; -- Setup ORTEST() array of ordering parameters
|
|---|
| 4 | N OI,TST,WRD,I,DG
|
|---|
| 5 | S OI=+$G(ORDIALOG(PROMPT,INST)) Q:'OI
|
|---|
| 6 | I '$D(ORTEST) S TST=+$P($G(^ORD(101.43,OI,0)),U,2) D TEST^LR7OR3(TST,.ORTEST) S ORTEST=TST
|
|---|
| 7 | S WRD="GenWardInstructions" I $O(ORTEST(WRD,0)) D W !
|
|---|
| 8 | . W ! S I=0 F S I=$O(ORTEST(WRD,I)) Q:I'>0 W !,ORTEST(WRD,I,0)
|
|---|
| 9 | S DG=$P($G(^ORD(101.43,+OI,"LR")),U,6) S:'$L(DG) DG="LAB"
|
|---|
| 10 | S DG=$O(^ORD(100.98,"B",DG,0)) S:DG ORDG=DG
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | CKTYP ; -- ck type of test [Exit Action]
|
|---|
| 14 | N X,Y S X=$G(ORDIALOG(PROMPT,INST)) Q:'X
|
|---|
| 15 | S Y=$P($G(^ORD(101.43,+X,"LR")),U,7)
|
|---|
| 16 | I (Y="O")!(Y="N") W $C(7),!,"This test may not be ordered anymore. Please select another test." S ORQUIT=1 D WAIT Q
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | WAIT ; -- Wait for user
|
|---|
| 20 | N X W !,"Press <return> to continue ..." R X:DTIME
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | SHOWMAX ; -- Setup max days allowed for cont orders
|
|---|
| 24 | I $S('$G(ORSCH):1,"CD"'[$P($G(^PS(51.1,+ORSCH,0)),U,5):1,1:0) K ORDIALOG(PROMPT,INST) Q ;just in case
|
|---|
| 25 | N Y,OK S ORSMAX=$P($G(^PS(51.1,ORSCH,0)),U,7),ORSTMS=$P($G(^(0)),U,3)
|
|---|
| 26 | S ORSMAX=$S('$G(ORSMAX):ORMAX,$G(ORTYPE)="Z":ORSMAX,ORMAX<ORSMAX:ORMAX,1:ORSMAX),ORSTMS=$S(ORSMAX&ORSTMS:ORSMAX*1440\ORSTMS,1:"") ;set max days, times
|
|---|
| 27 | I FIRST,$G(ORTYPE)="Q" S Y=$G(ORDIALOG(PROMPT,INST)) I $L(Y) S OK=$$CKMAX(Y) Q:OK K ORDIALOG(PROMPT,INST) ;Q if valid, else fall thru and prompt
|
|---|
| 28 | W !!,"Maximum number of days for continuous orders is "_ORSMAX_"; enter a duration",!,"as either a number of days (3) or Xnumber of times (X3).",!
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | CKMAX(X) ; -- Ck duration X against max allowed
|
|---|
| 32 | N Y S Y=1
|
|---|
| 33 | I +X=X S Y=$S(X<0:"0^Cannot order in the past.",'ORSMAX:1,X'>ORSMAX:1,1:"0^Cannot order more than "_ORSMAX_" days in advance.") G CKQ
|
|---|
| 34 | I (X'?1"X"1.N),(X'?1"x"1.N) S Y="0^Enter either a number of days or X_number of times." G CKQ
|
|---|
| 35 | I ORSTMS,+$E(X,2,9)>ORSTMS S Y="0^Cannot order more than "_ORSTMS_" time* s." G CKQ
|
|---|
| 36 | I 'ORSTMS,+$E(X,2,9)>ORSMAX S Y="0^Cannot order for more than "_ORSMAX_" days." G CKQ ; day of week schedule
|
|---|
| 37 | S Y=1
|
|---|
| 38 | CKQ Q Y
|
|---|
| 39 | ;
|
|---|
| 40 | SAMPLE() ; -- Get default sample from Test for INST
|
|---|
| 41 | N X,Y I $L($G(LRFSAMP)) Q LRFSAMP
|
|---|
| 42 | I (ORCOLLCT="LC")!(ORCOLLCT="I") S X=$G(ORTEST("Lab CollSamp")) G SAMPQ
|
|---|
| 43 | S X=$G(ORTEST("Unique CollSamp")) G:X SAMPQ
|
|---|
| 44 | S X=$G(ORTEST("Default CollSamp"))
|
|---|
| 45 | SAMPQ S Y=+$G(ORTEST("CollSamp",+X))
|
|---|
| 46 | Q Y
|
|---|
| 47 | ;
|
|---|
| 48 | ENSAMP ; -- Get list of samples to pick from
|
|---|
| 49 | Q:$G(ORDIALOG(PROMPT,"LIST")) N I,CNT,X,Y S (I,CNT)=0
|
|---|
| 50 | F S I=$O(ORTEST("CollSamp",I)) Q:I'>0 S X=$G(ORTEST("CollSamp",I)) D
|
|---|
| 51 | . S Y=$P(X,U,1,2)_" "_$$GET1^DIQ(61,+$P(X,U,3)_",",.01)_" "_$P(X,U,4)
|
|---|
| 52 | . S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=Y
|
|---|
| 53 | . S ORDIALOG(PROMPT,"LIST","B",$P(X,U,2))=+X
|
|---|
| 54 | S:CNT ORDIALOG(PROMPT,"LIST")=CNT_$S($$SECTION'="MI":"^1",1:"")
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | ASKSAMP() ; -- Ask for Collection Sample?
|
|---|
| 58 | N X,Y,DIR,DEFSAMP,SAMP0
|
|---|
| 59 | S DEFSAMP=$G(ORDIALOG(PROMPT,INST)),SAMP0=$G(^LAB(62,+DEFSAMP,0))
|
|---|
| 60 | I $G(ORTYPE)="Z",DEFSAMP Q 1
|
|---|
| 61 | I (ORCOLLCT="LC")!(ORCOLLCT="I"),$G(ORTEST("Lab CollSamp")) W !!,"Lab will collect "_$P(SAMP0,U)_" "_$P(SAMP0,U,3)_".",! Q 0
|
|---|
| 62 | I $G(ORTEST("Unique CollSamp")),DEFSAMP Q 0 ; unique -> don't ask
|
|---|
| 63 | I 'DEFSAMP!('FIRST) Q 1 ; no default or edit -> ask
|
|---|
| 64 | I $G(ORDIALOG(PROMPT,"LIST"))="1^1" Q 0 ; only one choice
|
|---|
| 65 | S DIR(0)="YA",DIR("A")="Is "_$P(SAMP0,U)_" "_$P(SAMP0,U,3)_" the correct sample to collect? ",DIR("B")="Yes"
|
|---|
| 66 | D ^DIR I $D(DTOUT)!$D(DUOUT) S ORQUIT=1 Q 0
|
|---|
| 67 | D:'Y LIST^ORCD
|
|---|
| 68 | Q 'Y
|
|---|
| 69 | ;
|
|---|
| 70 | SECTION() ; -- Returns Lab section of Orderable Item
|
|---|
| 71 | N PTR,X
|
|---|
| 72 | S PTR=$O(^ORD(101.41,"AB","OR GTX ORDERABLE ITEM",0))
|
|---|
| 73 | S X=$P($G(^ORD(101.43,+$G(ORDIALOG(PTR,1)),"LR")),U,6)
|
|---|
| 74 | Q X
|
|---|
| 75 | ;
|
|---|
| 76 | SHOWCOMM(SAMP) ; -- Show comments for sample
|
|---|
| 77 | Q:'$G(SAMP) Q:'$G(ORTEST) N ORCOMM,I
|
|---|
| 78 | D SCOM^LR7OR3(+ORTEST,SAMP,.ORCOMM)
|
|---|
| 79 | S I=0 F S I=$O(ORCOMM(I)) Q:I'>0 W !,ORCOMM(I,0)
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | SPECIMEN() ; -- Get default specimen from Sample for INST
|
|---|
| 83 | N X,Y I $L($G(LRFSPEC)) S Y=LRFSPEC
|
|---|
| 84 | E S X=$$VAL^ORCD("COLLECTION SAMPLE"),Y=+$P($G(^LAB(62,+X,0)),U,2)
|
|---|
| 85 | Q Y
|
|---|
| 86 | ;
|
|---|
| 87 | SPECHELP ; -- Xecutable help for Specimen prompt
|
|---|
| 88 | I '$D(^LAB(61,"E")) D P^ORCDLGH Q
|
|---|
| 89 | W !,"Choose from: "
|
|---|
| 90 | N SP,I,DONE,CNT S (CNT,DONE)=0,SP=""
|
|---|
| 91 | F S SP=$O(^LAB(61,"E",SP)) Q:SP="" S I=+$O(^(SP,0)) I I D
|
|---|
| 92 | . S CNT=CNT+1 I CNT>(IOSL-2) S CNT=0 I '$$MORE^ORCD S DONE=1 Q
|
|---|
| 93 | . W !," "_$P($G(^LAB(61,I,0)),U)
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | URGENCY ; -- Get list of urgencies to pick from
|
|---|
| 97 | Q:$D(ORDIALOG(PROMPT,"LIST")) N I,J,X
|
|---|
| 98 | I $G(ORTEST("Default Urgency")) S ORDIALOG(PROMPT,"LIST")="1^1",ORDIALOG(PROMPT,"LIST",1)=ORTEST("Default Urgency") Q ; Forced Urgency
|
|---|
| 99 | I '$D(ORTEST("Urgencies")) S ORDIALOG(PROMPT,"LIST")="0^1" Q
|
|---|
| 100 | S (I,J)=0 F S I=$O(ORTEST("Urgencies",I)) Q:I'>0 D
|
|---|
| 101 | . S X=ORTEST("Urgencies",I) I $G(ORCOLLCT)="LC",'$P($G(^LAB(62.05,+X,0)),U,2) Q ; Lab cannot collect
|
|---|
| 102 | . S J=J+1,ORDIALOG(PROMPT,"LIST",J)=X,ORDIALOG(PROMPT,"LIST","B",$P(X,U,2))=+X
|
|---|
| 103 | S ORDIALOG(PROMPT,"LIST")=J_"^1"
|
|---|
| 104 | Q
|
|---|
| 105 | ;
|
|---|
| 106 | ASKURG() ; -- Ask urgency prompt?
|
|---|
| 107 | I $G(ORTEST("Default Urgency")) Q 0 ; Forced Urgency
|
|---|
| 108 | I FIRST,$G(ORL) Q $$GET^XPAR("ALL^"_ORL,"LR ASK URGENCY")
|
|---|
| 109 | Q (+$G(ORDIALOG(PROMPT,"LIST"))>1)
|
|---|
| 110 | ;
|
|---|
| 111 | REQDCOMM() ; -- Process required comments
|
|---|
| 112 | I $O(^TMP("ORWORD",$J,PROMPT,INST,0)) Q 0 ;edit as WP
|
|---|
| 113 | N LRTEST,LRSAMP,LRSPEC,LRTSTN,LRTCOM,LRCCOM,DA,CNT,I,REQDCOMM
|
|---|
| 114 | S LRSAMP=$$VAL^ORCD("COLLECTION SAMPLE"),LRSPEC=$$VAL^ORCD("SPECIMEN")
|
|---|
| 115 | S LRTSTN=1,LRTEST(1)=+ORTEST,DA=$O(^LAB(60,LRTEST(1),3,"B",+LRSAMP,0))
|
|---|
| 116 | S REQDCOMM=$P($G(^LAB(60,LRTEST(1),3,+DA,0)),U,6)
|
|---|
| 117 | S:'REQDCOMM REQDCOMM=+$P($G(^LAB(60,LRTEST(1),0)),U,19) Q:'REQDCOMM 1
|
|---|
| 118 | I $G(ORTYPE)="Z",$P($G(^LAB(62.07,+REQDCOMM,0)),U)'="ORDER COMMENT" Q 1
|
|---|
| 119 | X:$D(^LAB(62.07,REQDCOMM,.1)) ^(.1)
|
|---|
| 120 | S (CNT,I)=0 K REQDCOMM
|
|---|
| 121 | F S I=$O(LRTCOM(LRTEST(1),I)) Q:I'>0 S CNT=CNT+1,REQDCOMM(CNT,0)=LRTCOM(LRTEST(1),I)
|
|---|
| 122 | S:$L($G(LRCCOM)) CNT=CNT+1,REQDCOMM(CNT,0)=LRCCOM
|
|---|
| 123 | I CNT S REQDCOMM(0)="^^"_CNT_U_CNT_U_DT_U_U,ORDIALOG(PROMPT,INST)="^TMP(""ORWORD"",$J,"_PROMPT_","_INST_")" M ^TMP("ORWORD",$J,PROMPT,INST)=REQDCOMM
|
|---|
| 124 | RQ Q 1
|
|---|
| 125 | ;
|
|---|
| 126 | XHELP(PTR) ; -- Xecutable help
|
|---|
| 127 | I $D(ORDIALOG(PTR,"LIST")),X="?"!$P(ORDIALOG(PTR,"LIST"),U,2) D LIST^ORCD Q
|
|---|
| 128 | D P^ORCDLGH ; ??-help
|
|---|
| 129 | Q
|
|---|
| 130 | ;
|
|---|
| 131 | CHANGED(FLD) ; -- Kill dependent values when FLD changes
|
|---|
| 132 | N PROMPTS,P,NAME,PTR K ORCOLLCT
|
|---|
| 133 | S PROMPTS="COLLECTION SAMPLE^SPECIMEN^WORD PROCESSING 1^START DATE/TIME"
|
|---|
| 134 | S:FLD="OI" PROMPTS="COLLECTION TYPE^"_PROMPTS_"^LAB URGENCY"
|
|---|
| 135 | F P=1:1:$L(PROMPTS,U) S NAME=$P(PROMPTS,U,P),PTR=$O(^ORD(101.41,"AB","OR GTX "_NAME,0)) I PTR K ORDIALOG(PTR,ORI),ORDIALOG(PTR,"LIST")
|
|---|
| 136 | Q
|
|---|
| 137 | ;
|
|---|
| 138 | LB(ORDER) ; -- Returns 1 or 0, if "LB #" is already in text
|
|---|
| 139 | N I,Y S I=0,Y=0
|
|---|
| 140 | F S I=$O(^OR(100,+ORDER,1,I)) Q:I'>0 I $G(^(I,0))["LB #" S Y=1 Q
|
|---|
| 141 | Q Y
|
|---|
| 142 | ;
|
|---|
| 143 | DATE(X) ; Free text input to FM time
|
|---|
| 144 | N %DT,Y
|
|---|
| 145 | D ^%DT
|
|---|
| 146 | Q Y
|
|---|
| 147 | ;
|
|---|
| 148 | XSCH ; -- xecutable help for schedule prompt
|
|---|
| 149 | N X,IFN,CNT,Z,DONE
|
|---|
| 150 | W !!,"Choose from:" S CNT=1
|
|---|
| 151 | S X="" F S X=$O(^PS(51.1,"APLR",X)) Q:X="" S IFN=0 D Q:$G(DONE)
|
|---|
| 152 | . F S IFN=$O(^PS(51.1,"APLR",X,IFN)) Q:IFN'>0 D Q:$G(DONE)
|
|---|
| 153 | .. W !," "_X S CNT=CNT+1 Q:CNT'>(IOSL-5) S CNT=0
|
|---|
| 154 | .. W !," '^' TO STOP: " R Z:DTIME S:'$T!(Z["^") DONE=1
|
|---|
| 155 | W !
|
|---|
| 156 | Q
|
|---|
| 157 | ;
|
|---|
| 158 | MULT(ORIFN,CTYPE,CDATE) ;check multiple orders from VALID^ORCDLR1
|
|---|
| 159 | N KID,OREVENT,ORSTRT,OK,X,Y,%DT
|
|---|
| 160 | I '$D(CTYPE) S CTYPE=$$VALUE^ORCSAVE2(ORIFN,"COLLECT")
|
|---|
| 161 | Q:"SPWC"[CTYPE 0 ; only check LC and I
|
|---|
| 162 | I '$D(CDATE) S CDATE=$$VALUE^ORCSAVE2(ORIFN,"START")
|
|---|
| 163 | D AM^ORCSAVE2:CDATE="AM",NEXT^ORCSAVE2:CDATE="NEXT" ; returns X
|
|---|
| 164 | S %DT="T" S:'$D(X) X=CDATE D ^%DT I Y<1 Q 0
|
|---|
| 165 | D SCHEDULE^ORCSEND1(ORIFN,"LR",.ORSTRT,Y) Q:ORSTRT'>1 0 ; get all starts
|
|---|
| 166 | S KID=0,OK=1 F S KID=$O(ORSTRT(KID)) Q:'KID!('OK) D
|
|---|
| 167 | . I CTYPE="LC" S OK=$$LABCOLL^ORCDLR1(KID) Q
|
|---|
| 168 | . S OK=$$IMMCOLL^ORCDLR1(KID)
|
|---|
| 169 | I OK Q 0
|
|---|
| 170 | Q "1^One or more of the multiple orders will be changed to Ward Collect"
|
|---|
