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/OREVNTX1.m

    r613 r623  
    1 OREVNTX1        ; SLC/JLI - Event delayed orders RPC's ;9/19/02  13:35
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,165,149,243**;Dec 17, 1997;Build 242
    3         ;
    4 PUTEVNT(ORY,DFN,EVT,ORIFN)      ; Save new patient delayed events to file 100.2
    5         S ORY=$$NEW^OREVNT(DFN,EVT,ORIFN)
    6         Q
    7         ;
    8 GTEVT(ORY,PTEVT)        ; Return Event infomation based on PTEVT ptr #100.2
    9         ;EVTID     ptr #100.5
    10         Q:'+PTEVT
    11         N EVTID,EVTTYPE,EVTNAME,EVTDISP,EVTDLG,PRTEVT
    12         S (EVTTYPE,EVTNAME,EVTDISP,PRTEVT)=""
    13         S EVTDLG=0
    14         I '$P(^ORE(100.2,+$G(PTEVT),0),U,2) Q
    15         S EVTID=$$EVT^OREVNTX(PTEVT)
    16         S PRTEVT=$P(^ORD(100.5,EVTID,0),U,12)
    17         I PRTEVT S EVTTYPE=$P(^ORD(100.5,PRTEVT,0),U,2)
    18         E  S EVTTYPE=$P(^ORD(100.5,EVTID,0),U,2)
    19         I $D(^ORD(100.5,EVTID,0)) D
    20         . S EVTNAME=$P(^ORD(100.5,EVTID,0),U,1)
    21         . S EVTDISP=$P(^ORD(100.5,EVTID,0),U,8)
    22         . S EVTDLG=$P(^ORD(100.5,EVTID,0),U,4)
    23         S ORY=EVTTYPE_U_EVTID_U_EVTNAME_U_EVTDISP_U_EVTDLG
    24         Q
    25 GTEVT1(ORY,EVT) ; Return Event information based on EVT ptr #100.5
    26         ;EVT    ptr #100.5
    27         Q:'+EVT
    28         N EVTTYPE,EVTNAME,EVTDISP,EVTDLG,PRTEVT
    29         S (EVTDLG,PRTEVT)=0
    30         S PRTEVT=$P(^ORD(100.5,+EVT,0),U,12)
    31         I PRTEVT>0 S EVTTYPE=$P(^ORD(100.5,PRTEVT,0),U,2)
    32         E  S EVTTYPE=$P(^ORD(100.5,+EVT,0),U,2)
    33         S EVTNAME=$P($G(^ORD(100.5,+EVT,0)),U,1)
    34         S EVTDISP=$P($G(^ORD(100.5,+EVT,0)),U,8)
    35         S EVTDLG=$P($G(^ORD(100.5,+EVT,0)),U,4)
    36         S ORY=EVTTYPE_U_EVT_U_EVTNAME_U_EVTDISP_U_EVTDLG
    37         Q
    38         ;
    39 EVT(ORY,PTEVT)  ; Return Event ptr #100.5, given PTEVT ptr #100.2
    40         Q:'+PTEVT
    41         S ORY=$$EVT^OREVNTX(PTEVT)
    42         Q
    43         ;
    44 EXISTS(ORY,DFN,EVT)     ;Returns PtEvtID ptr #100.2 if patient already has delayed orders
    45         I '+EVT S ORY=0 Q
    46         N PTEVT S (PTEVT,ORY)=0
    47         S PTEVT=$O(^ORE(100.2,"AE",+DFN,+EVT,PTEVT))
    48         I PTEVT>0 S ORY=PTEVT
    49         Q
    50         ;
    51 TYPEXT(ORY,DFN,EVT)     ; does EVT has delayed orders?
    52         ; 1 if Patient DFN has delayed orders for EVT
    53         ; 2 if Parent/Sibling event has delayed orders
    54         ; 0 if No delayed orders for EVT
    55         Q:'+EVT
    56         S ORY=$$EXISTS^OREVNTX(DFN,EVT)
    57         Q
    58         ;
    59 MATCH(ORY,DFN,EVT)      ;If Pt's current data match selected event
    60         ;DFN: patient DFN
    61         ;EVT: ptr to #100.5
    62         S ORY=0
    63         Q:('+DFN)!('+EVT)
    64         S ORY=$$MATCH^OREVNT(DFN,EVT)
    65         N TS,TSNM
    66         S TS=$S($G(ORTS):+ORTS,1:+$G(^DPT(DFN,.103)))
    67         S TSNM=$P($G(^DIC(45.7,TS,0)),U)
    68         S:ORY ORY=ORY_U_TSNM
    69         Q
    70         ;
    71 NAME(ORY,PTEVT) ; Return Event name from #100.5, given PTEVT ptr #100.2
    72         I PTEVT'>0 S ORY="" Q
    73         S ORY=$$NAME^OREVNTX(PTEVT)
    74         Q
    75         ;
    76 DIV(ORY,PTEVT)  ; Return division for PTEVT ptr #100.2
    77         Q:'+PTEVT
    78         S ORY=$$DIV^OREVNTX(PTEVT)
    79         Q
    80         ;
    81 DIV1(ORY,EVT)   ; Return division for EVT ptr #100.5
    82         Q:'+EVT
    83         S ORY=+$P($G(^ORD(100.5,+EVT,0)),U,3) S:ORY<1 ORY=+$G(DUZ(2))
    84         Q
    85         ;
    86 LOC(ORY,PTEVT)  ; Return default hospital location ^SC( for PTEVT ptr #100.2
    87         Q:'+PTEVT
    88         S ORY=$$LOC^OREVNTX(PTEVT)
    89         S ORY=+ORY
    90         Q
    91         ;
    92 LOC1(ORY,EVT)   ; Return default hospital location ^SC( for EVT ptr #100.5
    93         Q:'+EVT
    94         S ORY=+$P($G(^ORD(100.5,+EVT,0)),U,9) S:ORY<1 ORY=+$G(ORL)
    95         Q
    96         ;
    97 CHGEVT(ORY,NEWEVT,ORIDS)        ; Change order's event
    98         N ORI
    99         S ORI=0
    100         F  S ORI=$O(ORIDS(ORI)) Q:'+ORI  D
    101         . D CHGEVT^OREVNTX(+$G(ORIDS(ORI)),NEWEVT)
    102         Q
    103         ;
    104 EMPTY(ORY,PTEVT)        ; Return 1 if PTEVT doesn't have any orders
    105         Q:'+PTEVT
    106         S ORY=$$EMPTY^OREVNTX(PTEVT)
    107         Q
    108         ;
    109 DELPTEVT(ORY,PTEVT)     ; Delete Patient Event in #100.2
    110         Q:'+PTEVT
    111         D CANCEL^OREVNTX(PTEVT)
    112         Q
    113         ;
    114 UPDTOR(ORY,PTIFN,ORIFN,PTEVT)   ; If delayed order was DCed, then update the EVENT and "AEVNT"
    115         Q  ;Don't ever need to do this!
    116 CURSPE(ORY,PTIFN)       ; Return current treating specialty
    117         Q:'PTIFN
    118         N SPEC S SPEC=$$PT^DGPMOBS(PTIFN),ORY=""
    119         I SPEC'<0 S ORY=$P(SPEC,U,3)_U_$P(SPEC,U,2)_U_$P(SPEC,U) ;name^ien^obs flag
    120         Q
    121 DFLTEVT(ORY,PVIFN)      ; Return default release event based on provider IFN
    122         N CMEVTLST,IDX
    123         S CMEVTLST="",IDX=0
    124         D GETLST^OREV3(.CMEVTLST)
    125         F  S IDX=$O(CMEVTLST(IDX)) Q:'IDX  D
    126         . I $P($G(CMEVTLST(IDX)),U,2) S ORY=$P($G(CMEVTLST(IDX)),U) Q
    127         Q
    128 CMEVTS(ORY,CLOC)        ;Return common event list
    129         N IDX,X0,X,LOC
    130         S:CLOC>0 LOC=CLOC
    131         S IDX=0,ORY=""
    132         D GETLST^OREV3(.ORY)
    133         F  S IDX=$O(ORY(IDX)) Q:'IDX  D
    134         . S X0=""
    135         . S:$L($G(^ORD(100.5,+ORY(IDX),0))) X0=$G(^(0))
    136         . I '$L($P(X0,U,2)) D
    137         .. S X=$P(X0,U,12) S:X $P(X0,U,2)=$P($G(^ORD(100.5,+X,0)),U,2)
    138         . S:$L(X0) ORY(IDX)=+ORY(IDX)_U_X0
    139         Q
    140         ;
    141 DELDFLT(ORY,PVIFN)      ; Delete default release event
    142         Q:'PVIFN
    143         N ORERR
    144         S ORERR=""
    145         D DEL^XPAR(PVIFN_";VA(200,","OREVNT DEFAULT",1,.ORERR)
    146         Q
    147 WRLSTED(LST,LOC,EVTID)  ; Return list of dialogs for writing event delayed orders
    148         ; .Y(n): DlgName^ListBox Text
    149 WRLST1  N ANENT
    150         S LOC=+$G(LOC)_";SC(" I 'LOC S LOC=""
    151         S ANENT="ALL^USR.`"_DUZ_"^"_LOC_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
    152         N MNU,SEQ,IEN,ITM,TXT,FID,DGRP,X,TYP
    153         S MNU=$$GET^XPAR(ANENT,"ORWDX WRITE ORDERS EVENT LIST",EVTID,"I") Q:'MNU
    154         S SEQ=0 F  S SEQ=$O(^ORD(101.41,MNU,10,"B",SEQ)) Q:'SEQ  D
    155         . S IEN=0 F  S IEN=$O(^ORD(101.41,MNU,10,"B",SEQ,IEN)) Q:'IEN  D
    156         . . S X=$G(^ORD(101.41,MNU,10,IEN,0)),ITM=+$P(X,U,2),TXT=$P(X,U,4)
    157         . . S X=$G(^ORD(101.41,ITM,5)),FID=+$P(X,U,5)
    158         . . S X=$G(^ORD(101.41,ITM,0)),TYP=$P(X,U,4),DGRP=+$P(X,U,5)
    159         . . S:'$L(TXT) TXT=$P(X,U,2)
    160         . . I TYP="M" S:'FID FID=1001
    161         . . S LST(SEQ)=ITM_";"_FID_";"_DGRP_";"_TYP_U_TXT
    162         Q
    163         ;
    164 GETDLG(LST,DLGID)       ; Return dialog infomation based on the DLGID
    165         N DIEN,DFID,DTXT,DTYP,DGRP,X0,X5
    166         S DLGID=+DLGID
    167         Q:'DLGID
    168         S X0=^ORD(101.41,DLGID,0),X5=$G(^(5))
    169         S DGRP=+$P(X0,U,5),DFID=+$P(X5,U,5),DTXT=$P(X5,U,4),DTYP=$P(X0,U,4)
    170            S:'$L(DTXT) DTXT=$P(X0,U,2)
    171         I $P(X0,U,4)="M" S:'DFID DFID=1001
    172         S LST=DLGID_";"_DFID_";"_DGRP_";"_DTYP_U_DTXT
    173         Q
    174 DONE(LST,PTEVT) ; Terminate PTEvt
    175         Q:'PTEVT
    176         D DONE^OREVNTX(PTEVT)
    177         D ACTLOG^OREVNTX(PTEVT,"MN")
    178         Q
    179 SETDFLT(ORY,EVT)        ;Set personal default event
    180         N ERR,VAL S ERR=""
    181         Q:'$D(^ORD(100.5,EVT,0))
    182         S VAL=$P(^ORD(100.5,EVT,0),U)
    183         D EN^XPAR(DUZ_";VA(200,","OREVNT DEFAULT",1,VAL,ERR)
    184         S ORY=ERR
    185         Q
    186 CPACT(ORY,EVT)  ; Return True/False to display active orders for copy
    187         ; EVT ptr to #100.5
    188         Q:'EVT
    189         S ORY=0
    190         Q:'$D(^ORD(100.5,EVT,0))
    191         S ORY=$P(^ORD(100.5,EVT,0),U,11)
    192         Q
    193 PRMPTID(ORY,PRTNM)      ;Return event prompt IEN for OR GTX EVENT
    194         S:$D(^ORD(101.41,"B","OR GTX EVENT")) ORY=$O(^("OR GTX EVENT",0))
    195         Q
    196 ISDCOD(ORY,ORIFN)       ;True: the order need to be filtered out
    197         N PAS,X3,X0,ORGRPLST,THEGRP,IDX,ODGRP
    198         S (ORY,IDX)=0
    199         Q:'$D(^OR(100,+ORIFN,0))
    200         S X0=$G(^OR(100,+ORIFN,0))
    201         S ODGRP=$P(X0,U,11)
    202         D GETLST^XPAR(.ORGRPLST,"ALL","OREVNT EXCLUDE DGRP")
    203         F  S IDX=$O(ORGRPLST(IDX)) Q:'IDX!ORY  D
    204         . S THEGRP=$P($G(ORGRPLST(IDX)),U,2)
    205         . I $$GRPCHK(THEGRP,ODGRP) S ORY=1
    206         I ORY Q
    207         S PAS=";1;"
    208         S:$D(^OR(100,+ORIFN,3)) X3=^OR(100,+ORIFN,3)
    209         S:(PAS'[(";"_$P(X3,U,3)_";")) ORY=0
    210         Q
    211 DEFLTS(ORY,EVTID)       ;Return default specialty for EVTID(#100.5)
    212         Q:'+EVTID
    213         N PRTEVT
    214         S PRTEVT=0
    215         S PRTEVT=$P(^ORD(100.5,+EVTID,0),U,12)
    216         I PRTEVT>0 S EVTID=PRTEVT
    217         S ORY=$$DEFTS^ORCDADT(EVTID)
    218         Q
    219         ;
    220 MULTS(ORY,EVTID)        ;Return specialty list for the EVTID(#100.5)
    221         Q:'+EVTID
    222         N I,CNT,X,Y S (I,CNT)=0
    223         N PRTEVT
    224         S PRTEVT=0
    225         S PRTEVT=$P(^ORD(100.5,+EVTID,0),U,12)
    226         I PRTEVT>0 S EVTID=PRTEVT
    227         F  S I=$O(^ORD(100.5,+$G(EVTID),"TS",I)) Q:I<1  S X=+$G(^(I,0)) D
    228         . S Y=$$GET1^DIQ(45.7,X_",",.01)
    229         . S CNT=CNT+1,ORY(CNT)=X_U_Y
    230         Q
    231         ;
    232 PRTIDS(ORY,IDS) ;Return some prompt ids from #101.41
    233         ; treating specialty Id^attending provider id
    234         N IDX,ORTS,ORATT
    235         S (ORY,ORTS,ORATT)=""
    236         S IDX=$O(^ORD(101.41,"B","OR GTX TREATING SPECIALTY",0))
    237         S:$D(^ORD(101.41,IDX,1)) ORTS=$P($G(^ORD(101.41,IDX,1)),U,2,3)
    238         S IDX=$O(^ORD(101.41,"B","OR GTX PROVIDER",0))
    239         S:$D(^ORD(101.41,IDX,1)) ORATT=$P($G(^ORD(101.41,IDX,1)),U,2,3)
    240         S ORY=ORTS_"~"_ORATT
    241         Q
    242         ;
    243 DFLTDLG(ORY,EVTID)      ;Return event default dialog IEN
    244         S ORY=0
    245         Q:'$D(^ORD(100.5,+EVTID,0))
    246         S ORY=$P(^ORD(100.5,+EVTID,0),U,4)
    247         Q
    248 AUTHMREL(ORY,USER)      ;1: user can manual release delayed orders 0: can't
    249         S ORY=$$CANREL^OREV3
    250         Q
    251 HAVEPRT(ORY,PTEVT)      ;return parent patient event from #100.2
    252         Q:'+PTEVT
    253         S ORY=""
    254         S:$L($G(^ORE(100.2,PTEVT,1))) ORY=$P(^(1),U,5)
    255         Q
    256 GRPCHK(DG,AGRP) ;If an order's group belong to DG group
    257         N RST
    258         S RST=0
    259         N ORGRP
    260         D GRP^ORQ1(DG)
    261         S RST=$S($D(ORGRP(AGRP)):1,1:0)
    262         Q RST
    263 ODPTEVID(ORY,ORID)      ;Return PtEvtID based on the ORID
    264         Q:'$D(^OR(100,+ORID,0))
    265         S ORY=$P($G(^OR(100,+ORID,0)),U,17)
    266         Q
    267 COMP(ORY,PTEVT) ;Return 1 or 0 if PTEVT completed or not
    268         Q:'+PTEVT
    269         S ORY=$$COMP^OREVNTX(+PTEVT)
    270         Q
    271 ISHDORD(ORY,ORID)       ;Return 1 if it's on-hold med order
    272         Q:'+ORID
    273         Q:'$D(^OR(100,+ORID,0))
    274         N STS,HDSTS,ODGP,INPT,OUPT,MEDS,IVMD
    275         S HDSTS=$O(^ORD(100.01,"B","HOLD",0))
    276         S STS=$P($G(^OR(100,+ORID,3)),U,3)
    277         S INPT=$O(^ORD(100.98,"B","UD RX",0))
    278         S OUPT=$O(^ORD(100.98,"B","O RX",0))
    279         S MEDS=$O(^ORD(100.98,"B","RX",0))
    280         S IVMD=$O(^ORD(100.98,"B","IV RX",0))
    281         S ODGP=$P(^OR(100,+ORID,0),U,11)
    282         I (U_INPT_U_OUPT_U_MEDS_U_IVMD_U[U_ODGP_U),(HDSTS=STS) S ORY=1
    283         Q
    284 ISPASS(ORY,PTEVTID,EVTTYPE)     ;Return 1 if it's a pass event
    285         S ORY=$$EVT^OREVNTX(PTEVTID)
    286         S ORY=$P($G(^ORD(100.5,+ORY,0)),U,7)
    287         I EVTTYPE="T",ORY,ORY<4 S ORY=1
    288         E  S ORY=0
    289         Q
    290 ISPASS1(ORY,EVTID,EVTTYPE)      ;Return 1 if it's a pass event
    291         S ORY=$P($G(^ORD(100.5,+EVTID,0)),U,7)
    292         I EVTTYPE="T",ORY,ORY<4 S ORY=1
    293         E  S ORY=0
    294         Q
    295 DLGIEN(ORY,DLGNAME)     ;Return Order Dialog IEN based on name
    296         Q:'$D(^ORD(101.41,"B",DLGNAME))
    297         S ORY=$O(^ORD(101.41,"B",DLGNAME,0))
    298         Q
    299 GETSTS(ORY,ORDID)       ;Return Order status
    300         Q:'+ORDID
    301         Q:'$D(^OR(100,+ORDID,0))
    302         S ORY=$P($G(^OR(100,+ORDID,3)),U,3)
    303         Q
     1OREVNTX1 ; SLC/JLI - Event delayed orders RPC's ;9/19/02  13:35
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,165,149**;Dec 17, 1997
     3 ;
     4PUTEVNT(ORY,DFN,EVT,ORIFN) ; Save new patient delayed events to file 100.2
     5 S ORY=$$NEW^OREVNT(DFN,EVT,ORIFN)
     6 Q
     7 ;
     8GTEVT(ORY,PTEVT) ; Return Event infomation based on PTEVT ptr #100.2
     9 ;EVTID     ptr #100.5
     10 Q:'+PTEVT
     11 N EVTID,EVTTYPE,EVTNAME,EVTDISP,EVTDLG,PRTEVT
     12 S (EVTTYPE,EVTNAME,EVTDISP,PRTEVT)=""
     13 S EVTDLG=0
     14 I '$P(^ORE(100.2,+$G(PTEVT),0),U,2) Q
     15 S EVTID=$$EVT^OREVNTX(PTEVT)
     16 S PRTEVT=$P(^ORD(100.5,EVTID,0),U,12)
     17 I PRTEVT S EVTTYPE=$P(^ORD(100.5,PRTEVT,0),U,2)
     18 E  S EVTTYPE=$P(^ORD(100.5,EVTID,0),U,2)
     19 I $D(^ORD(100.5,EVTID,0)) D
     20 . S EVTNAME=$P(^ORD(100.5,EVTID,0),U,1)
     21 . S EVTDISP=$P(^ORD(100.5,EVTID,0),U,8)
     22 . S EVTDLG=$P(^ORD(100.5,EVTID,0),U,4)
     23 S ORY=EVTTYPE_U_EVTID_U_EVTNAME_U_EVTDISP_U_EVTDLG
     24 Q
     25GTEVT1(ORY,EVT) ; Return Event information based on EVT ptr #100.5
     26 ;EVT    ptr #100.5
     27 Q:'+EVT
     28 N EVTTYPE,EVTNAME,EVTDISP,EVTDLG,PRTEVT
     29 S (EVTDLG,PRTEVT)=0
     30 S PRTEVT=$P(^ORD(100.5,+EVT,0),U,12)
     31 I PRTEVT>0 S EVTTYPE=$P(^ORD(100.5,PRTEVT,0),U,2)
     32 E  S EVTTYPE=$P(^ORD(100.5,+EVT,0),U,2)
     33 S EVTNAME=$P($G(^ORD(100.5,+EVT,0)),U,1)
     34 S EVTDISP=$P($G(^ORD(100.5,+EVT,0)),U,8)
     35 S EVTDLG=$P($G(^ORD(100.5,+EVT,0)),U,4)
     36 S ORY=EVTTYPE_U_EVT_U_EVTNAME_U_EVTDISP_U_EVTDLG
     37 Q
     38 ;
     39EVT(ORY,PTEVT) ; Return Event ptr #100.5, given PTEVT ptr #100.2
     40 Q:'+PTEVT
     41 S ORY=$$EVT^OREVNTX(PTEVT)
     42 Q
     43 ;
     44EXISTS(ORY,DFN,EVT) ;Returns PtEvtID ptr #100.2 if patient already has delayed orders
     45 I '+EVT S ORY=0 Q
     46 N PTEVT S (PTEVT,ORY)=0
     47 S PTEVT=$O(^ORE(100.2,"AE",+DFN,+EVT,PTEVT))
     48 I PTEVT>0 S ORY=PTEVT
     49 Q
     50 ;
     51TYPEXT(ORY,DFN,EVT) ; does EVT has delayed orders?
     52 ; 1 if Patient DFN has delayed orders for EVT
     53 ; 2 if Parent/Sibling event has delayed orders
     54 ; 0 if No delayed orders for EVT
     55 Q:'+EVT
     56 S ORY=$$EXISTS^OREVNTX(DFN,EVT)
     57 Q
     58 ;
     59MATCH(ORY,DFN,EVT) ;If Pt's current data match selected event
     60 ;DFN: patient DFN
     61 ;EVT: ptr to #100.5
     62 S ORY=0
     63 Q:('+DFN)!('+EVT)
     64 S ORY=$$MATCH^OREVNT(DFN,EVT)
     65 N TS,TSNM
     66 S TS=$S($G(ORTS):+ORTS,1:+$G(^DPT(DFN,.103)))
     67 S TSNM=$P($G(^DIC(45.7,TS,0)),U)
     68 S:ORY ORY=ORY_U_TSNM
     69 Q
     70 ;
     71NAME(ORY,PTEVT) ; Return Event name from #100.5, given PTEVT ptr #100.2
     72 I PTEVT'>0 S ORY="" Q
     73 S ORY=$$NAME^OREVNTX(PTEVT)
     74 Q
     75 ;
     76DIV(ORY,PTEVT) ; Return division for PTEVT ptr #100.2
     77 Q:'+PTEVT
     78 S ORY=$$DIV^OREVNTX(PTEVT)
     79 Q
     80 ;
     81DIV1(ORY,EVT) ; Return division for EVT ptr #100.5
     82 Q:'+EVT
     83 S ORY=+$P($G(^ORD(100.5,+EVT,0)),U,3) S:ORY<1 ORY=+$G(DUZ(2))
     84 Q
     85 ;
     86LOC(ORY,PTEVT) ; Return default hospital location ^SC( for PTEVT ptr #100.2
     87 Q:'+PTEVT
     88 S ORY=$$LOC^OREVNTX(PTEVT)
     89 S ORY=+ORY
     90 Q
     91 ;
     92LOC1(ORY,EVT) ; Return default hospital location ^SC( for EVT ptr #100.5
     93 Q:'+EVT
     94 S ORY=+$P($G(^ORD(100.5,+EVT,0)),U,9) S:ORY<1 ORY=+$G(ORL)
     95 Q
     96 ;
     97CHGEVT(ORY,NEWEVT,ORIDS) ; Change order's event
     98 N ORI
     99 S ORI=0
     100 F  S ORI=$O(ORIDS(ORI)) Q:'+ORI  D
     101 . D CHGEVT^OREVNTX(+$G(ORIDS(ORI)),NEWEVT)
     102 Q
     103 ;
     104EMPTY(ORY,PTEVT) ; Return 1 if PTEVT doesn't have any orders
     105 Q:'+PTEVT
     106 S ORY=$$EMPTY^OREVNTX(PTEVT)
     107 Q
     108 ;
     109DELPTEVT(ORY,PTEVT) ; Delete Patient Event in #100.2
     110 Q:'+PTEVT
     111 D CANCEL^OREVNTX(PTEVT)
     112 Q
     113 ;
     114UPDTOR(ORY,PTIFN,ORIFN,PTEVT) ; If delayed order was DCed, then update the EVENT and "AEVNT"
     115 Q  ;Don't ever need to do this!
     116CURSPE(ORY,PTIFN) ; Return current treating specialty
     117 Q:'PTIFN
     118 N SPCID
     119 I $D(^DPT(PTIFN,.103)) D
     120 . S SPCID=$G(^DPT(PTIFN,.103))
     121 . S:SPCID ORY=$P($G(^DIC(45.7,SPCID,0)),U)_U_SPCID
     122 Q
     123DFLTEVT(ORY,PVIFN) ; Return default release event based on provider IFN
     124 N CMEVTLST,IDX
     125 S CMEVTLST="",IDX=0
     126 D GETLST^OREV3(.CMEVTLST)
     127 F  S IDX=$O(CMEVTLST(IDX)) Q:'IDX  D
     128 . I $P($G(CMEVTLST(IDX)),U,2) S ORY=$P($G(CMEVTLST(IDX)),U) Q
     129 Q
     130CMEVTS(ORY,CLOC) ;Return common event list
     131 N IDX,X0,X,LOC
     132 S:CLOC>0 LOC=CLOC
     133 S IDX=0,ORY=""
     134 D GETLST^OREV3(.ORY)
     135 F  S IDX=$O(ORY(IDX)) Q:'IDX  D
     136 . S X0=""
     137 . S:$L($G(^ORD(100.5,+ORY(IDX),0))) X0=$G(^(0))
     138 . I '$L($P(X0,U,2)) D
     139 .. S X=$P(X0,U,12) S:X $P(X0,U,2)=$P($G(^ORD(100.5,+X,0)),U,2)
     140 . S:$L(X0) ORY(IDX)=+ORY(IDX)_U_X0
     141 Q
     142 ;
     143DELDFLT(ORY,PVIFN) ; Delete default release event
     144 Q:'PVIFN
     145 N ORERR
     146 S ORERR=""
     147 D DEL^XPAR(PVIFN_";VA(200,","OREVNT DEFAULT",1,.ORERR)
     148 Q
     149WRLSTED(LST,LOC,EVTID) ; Return list of dialogs for writing event delayed orders
     150 ; .Y(n): DlgName^ListBox Text
     151WRLST1 N ANENT
     152 S LOC=+$G(LOC)_";SC(" I 'LOC S LOC=""
     153 S ANENT="ALL^USR.`"_DUZ_"^"_LOC_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
     154 N MNU,SEQ,IEN,ITM,TXT,FID,DGRP,X,TYP
     155 S MNU=$$GET^XPAR(ANENT,"ORWDX WRITE ORDERS EVENT LIST",EVTID,"I") Q:'MNU
     156 S SEQ=0 F  S SEQ=$O(^ORD(101.41,MNU,10,"B",SEQ)) Q:'SEQ  D
     157 . S IEN=0 F  S IEN=$O(^ORD(101.41,MNU,10,"B",SEQ,IEN)) Q:'IEN  D
     158 . . S X=$G(^ORD(101.41,MNU,10,IEN,0)),ITM=+$P(X,U,2),TXT=$P(X,U,4)
     159 . . S X=$G(^ORD(101.41,ITM,5)),FID=+$P(X,U,5)
     160 . . S X=$G(^ORD(101.41,ITM,0)),TYP=$P(X,U,4),DGRP=+$P(X,U,5)
     161 . . S:'$L(TXT) TXT=$P(X,U,2)
     162 . . I TYP="M" S:'FID FID=1001
     163 . . S LST(SEQ)=ITM_";"_FID_";"_DGRP_";"_TYP_U_TXT
     164 Q
     165 ;
     166GETDLG(LST,DLGID) ; Return dialog infomation based on the DLGID
     167 N DIEN,DFID,DTXT,DTYP,DGRP,X0,X5
     168 S DLGID=+DLGID
     169 Q:'DLGID
     170 S X0=^ORD(101.41,DLGID,0),X5=$G(^(5))
     171 S DGRP=+$P(X0,U,5),DFID=+$P(X5,U,5),DTXT=$P(X5,U,4),DTYP=$P(X0,U,4)
     172    S:'$L(DTXT) DTXT=$P(X0,U,2)
     173 I $P(X0,U,4)="M" S:'DFID DFID=1001
     174 S LST=DLGID_";"_DFID_";"_DGRP_";"_DTYP_U_DTXT
     175 Q
     176DONE(LST,PTEVT) ; Terminate PTEvt
     177 Q:'PTEVT
     178 D DONE^OREVNTX(PTEVT)
     179 D ACTLOG^OREVNTX(PTEVT,"MN")
     180 Q
     181SETDFLT(ORY,EVT) ;Set personal default event
     182 N ERR,VAL S ERR=""
     183 Q:'$D(^ORD(100.5,EVT,0))
     184 S VAL=$P(^ORD(100.5,EVT,0),U)
     185 D EN^XPAR(DUZ_";VA(200,","OREVNT DEFAULT",1,VAL,ERR)
     186 S ORY=ERR
     187 Q
     188CPACT(ORY,EVT) ; Return True/False to display active orders for copy
     189 ; EVT ptr to #100.5
     190 Q:'EVT
     191 S ORY=0
     192 Q:'$D(^ORD(100.5,EVT,0))
     193 S ORY=$P(^ORD(100.5,EVT,0),U,11)
     194 Q
     195PRMPTID(ORY,PRTNM) ;Return event prompt IEN for OR GTX EVENT
     196 S:$D(^ORD(101.41,"B","OR GTX EVENT")) ORY=$O(^("OR GTX EVENT",0))
     197 Q
     198ISDCOD(ORY,ORIFN) ;True: the order need to be filtered out
     199 N PAS,X3,X0,ORGRPLST,THEGRP,IDX,ODGRP
     200 S (ORY,IDX)=0
     201 Q:'$D(^OR(100,+ORIFN,0))
     202 S X0=$G(^OR(100,+ORIFN,0))
     203 S ODGRP=$P(X0,U,11)
     204 D GETLST^XPAR(.ORGRPLST,"ALL","OREVNT EXCLUDE DGRP")
     205 F  S IDX=$O(ORGRPLST(IDX)) Q:'IDX!ORY  D
     206 . S THEGRP=$P($G(ORGRPLST(IDX)),U,2)
     207 . I $$GRPCHK(THEGRP,ODGRP) S ORY=1
     208 I ORY Q
     209 S PAS=";1;"
     210 S:$D(^OR(100,+ORIFN,3)) X3=^OR(100,+ORIFN,3)
     211 S:(PAS'[(";"_$P(X3,U,3)_";")) ORY=0
     212 Q
     213DEFLTS(ORY,EVTID) ;Return default specialty for EVTID(#100.5)
     214 Q:'+EVTID
     215 N PRTEVT
     216 S PRTEVT=0
     217 S PRTEVT=$P(^ORD(100.5,+EVTID,0),U,12)
     218 I PRTEVT>0 S EVTID=PRTEVT
     219 S ORY=$$DEFTS^ORCDADT(EVTID)
     220 Q
     221 ;
     222MULTS(ORY,EVTID) ;Return specialty list for the EVTID(#100.5)
     223 Q:'+EVTID
     224 N I,CNT,X,Y S (I,CNT)=0
     225 N PRTEVT
     226 S PRTEVT=0
     227 S PRTEVT=$P(^ORD(100.5,+EVTID,0),U,12)
     228 I PRTEVT>0 S EVTID=PRTEVT
     229 F  S I=$O(^ORD(100.5,+$G(EVTID),"TS",I)) Q:I<1  S X=+$G(^(I,0)) D
     230 . S Y=$$GET1^DIQ(45.7,X_",",.01)
     231 . S CNT=CNT+1,ORY(CNT)=X_U_Y
     232 Q
     233 ;
     234PRTIDS(ORY,IDS) ;Return some prompt ids from #101.41
     235 ; treating specialty Id^attending provider id
     236 N IDX,ORTS,ORATT
     237 S (ORY,ORTS,ORATT)=""
     238 S IDX=$O(^ORD(101.41,"B","OR GTX TREATING SPECIALTY",0))
     239 S:$D(^ORD(101.41,IDX,1)) ORTS=$P($G(^ORD(101.41,IDX,1)),U,2,3)
     240 S IDX=$O(^ORD(101.41,"B","OR GTX PROVIDER",0))
     241 S:$D(^ORD(101.41,IDX,1)) ORATT=$P($G(^ORD(101.41,IDX,1)),U,2,3)
     242 S ORY=ORTS_"~"_ORATT
     243 Q
     244 ;
     245DFLTDLG(ORY,EVTID) ;Return event default dialog IEN
     246 S ORY=0
     247 Q:'$D(^ORD(100.5,+EVTID,0))
     248 S ORY=$P(^ORD(100.5,+EVTID,0),U,4)
     249 Q
     250AUTHMREL(ORY,USER) ;1: user can manual release delayed orders 0: can't
     251 S ORY=$$CANREL^OREV3
     252 Q
     253HAVEPRT(ORY,PTEVT) ;return parent patient event from #100.2
     254 Q:'+PTEVT
     255 S ORY=""
     256 S:$L($G(^ORE(100.2,PTEVT,1))) ORY=$P(^(1),U,5)
     257 Q
     258GRPCHK(DG,AGRP) ;If an order's group belong to DG group
     259 N RST
     260 S RST=0
     261 N ORGRP
     262 D GRP^ORQ1(DG)
     263 S RST=$S($D(ORGRP(AGRP)):1,1:0)
     264 Q RST
     265ODPTEVID(ORY,ORID) ;Return PtEvtID based on the ORID
     266 Q:'$D(^OR(100,+ORID,0))
     267 S ORY=$P($G(^OR(100,+ORID,0)),U,17)
     268 Q
     269COMP(ORY,PTEVT) ;Return 1 or 0 if PTEVT completed or not
     270 Q:'+PTEVT
     271 S ORY=$$COMP^OREVNTX(+PTEVT)
     272 Q
     273ISHDORD(ORY,ORID) ;Return 1 if it's on-hold med order
     274 Q:'+ORID
     275 Q:'$D(^OR(100,+ORID,0))
     276 N STS,HDSTS,ODGP,INPT,OUPT,MEDS,IVMD
     277 S HDSTS=$O(^ORD(100.01,"B","HOLD",0))
     278 S STS=$P($G(^OR(100,+ORID,3)),U,3)
     279 S INPT=$O(^ORD(100.98,"B","UD RX",0))
     280 S OUPT=$O(^ORD(100.98,"B","O RX",0))
     281 S MEDS=$O(^ORD(100.98,"B","RX",0))
     282 S IVMD=$O(^ORD(100.98,"B","IV RX",0))
     283 S ODGP=$P(^OR(100,+ORID,0),U,11)
     284 I (U_INPT_U_OUPT_U_MEDS_U_IVMD_U[U_ODGP_U),(HDSTS=STS) S ORY=1
     285 Q
     286ISPASS(ORY,PTEVTID,EVTTYPE) ;Return 1 if it's a pass event
     287 S ORY=$$EVT^OREVNTX(PTEVTID)
     288 S ORY=$P($G(^ORD(100.5,+ORY,0)),U,7)
     289 I EVTTYPE="T",ORY,ORY<4 S ORY=1
     290 E  S ORY=0
     291 Q
     292ISPASS1(ORY,EVTID,EVTTYPE) ;Return 1 if it's a pass event
     293 S ORY=$P($G(^ORD(100.5,+EVTID,0)),U,7)
     294 I EVTTYPE="T",ORY,ORY<4 S ORY=1
     295 E  S ORY=0
     296 Q
     297DLGIEN(ORY,DLGNAME) ;Return Order Dialog IEN based on name
     298 Q:'$D(^ORD(101.41,"B",DLGNAME))
     299 S ORY=$O(^ORD(101.41,"B",DLGNAME,0))
     300 Q
     301GETSTS(ORY,ORDID) ;Return Order status
     302 Q:'+ORDID
     303 Q:'$D(^OR(100,+ORDID,0))
     304 S ORY=$P($G(^OR(100,+ORDID,3)),U,3)
     305 Q
Note: See TracChangeset for help on using the changeset viewer.