Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDLR.m

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