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

    r613 r623  
    1 ORQ20   ; SLC/MKB - Detailed Order Report cont ;3/6/08  10:25
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,27,92,94,116,141,177,186,190,215,243**;Dec 17, 1997;Build 242
    3 ACT     ; -- add Activity [from ^ORQ2]
    4         N ORACT S ORACT=$P(ACTION,U,2)
    5         I ORACT'="NW",$P(ACTION,U,4)=5,$P(ACTION,U,15)=13 Q  ;skip canc actions
    6         N NVA,USER S:$P(^ORD(100.98,$P(^OR(100,+ORIFN,0),U,11),0),U)="NON-VA MEDICATIONS" NVA=1
    7         S CNT=CNT+1,@ORY@(CNT)=$$DATE($P(ACTION,U))_"  "_$$ACTION(ORACT)
    8         I $P(ACTION,U,13) S @ORY@(CNT)=@ORY@(CNT)_" entered by "_$$USER(+$P(ACTION,U,13))
    9         I ORACT="NW" D  ;Show original order text
    10         . N ORZ,I,ORIGVIEW S ORIGVIEW=2 D TEXT^ORQ12(.ORZ,ORIFN_";1",80)
    11         . S CNT=CNT+1,@ORY@(CNT)="     Order Text:        "_$G(ORZ(1))
    12         . S I=1 F  S I=$O(ORZ(I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORZ(I))
    13         I ORACT="XX" D  ;Changed - show new text
    14         . N ORZ,I,ORIGVIEW S ORIGVIEW=2 D TEXT^ORQ12(.ORZ,ORIFN_";"_ORI,80)
    15         . S CNT=CNT+1,@ORY@(CNT)="     Changed to:        "_$G(ORZ(1))
    16         . S I=1 F  S I=$O(ORZ(I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORZ(I))
    17 A1      I $P(ACTION,U,12) D  ;Nature of Order/Release
    18         . N ORZ S ORZ=$G(^ORD(100.02,+$P(ACTION,U,12),0))
    19         . S CNT=CNT+1,@ORY@(CNT)="     Nature of Order:   "_$P(ORZ,U)
    20         . I $P(OR0,U,17),(ORACT="NW") Q  ;see event
    21         . I "^V^P^"[(U_$P(ORZ,U,2)_U),$P(ACTION,U,16) S CNT=CNT+1,@ORY@(CNT)="     Released by:       "_$$USER(+$P(ACTION,U,17))_" on "_$$DATE($P(ACTION,U,16))
    22         I $P(OR0,U,17)&(ORACT="NW") D  ;Delayed Release Event
    23         . N EVT,X,ORV,I S EVT=+$P(OR0,U,17),X=$$NAME^OREVNTX(EVT)
    24         . S:$E(X,1,8)="Delayed " X=$E(X,9,99)
    25         . I $G(^ORE(100.2,EVT,1)),'$P(ACTION,U,16) S X=X_" on "_$$DATE(+^(1))
    26         . S CNT=CNT+1,@ORY@(CNT)="     Delayed Until:     "_X Q:'$P(ACTION,U,16)
    27         . D EVENT(.ORV) S CNT=CNT+1,@ORY@(CNT)="     Released by:       "_ORV(1)
    28         . S I=1 F  S I=$O(ORV(I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORV(I))
    29 A2      I $P(ACTION,U,5) S CNT=CNT+1,@ORY@(CNT)=$S($P(ACTION,U,4)=7:"      Dig",1:"     Elec")_" Signature:    "_$$USER(+$P(ACTION,U,5))_" on "_$$DATE($P(ACTION,U,6))
    30         I '$P(ACTION,U,5)!($P(ACTION,U,3)'=$P(ACTION,U,5)),'$$SERVCORR S CNT=CNT+1,@ORY@(CNT)="     "_$S($D(NVA):"Documented by:",1:"Ordered by:   ")_"     "_$$USER(+$P(ACTION,U,3))
    31         I '$P(ACTION,U,5),$L($P(ACTION,U,4)) D
    32         .I $P(ACTION,U,4)=0 D
    33         ..S USER=$$USER(+$P(ACTION,U,7))
    34         ..S CNT=CNT+1
    35         ..I USER'="" S @ORY@(CNT)="     Released by:       "_USER_" on "_$$DATE($P(ACTION,U,16))
    36         ..I USER="" S @ORY@(CNT)="        Released:       "_$$DATE($P(ACTION,U,16))
    37         .S CNT=CNT+1,@ORY@(CNT)="     Signature:         "_$$SIG($P(ACTION,U,4)) ;186
    38         ;I '$P(ACTION,U,5),$L($P(ACTION,U,4)) S:$P(ACTION,U,4)=0 CNT=CNT+1,@ORY@(CNT)="     Released by:       "_$$USER(+$P(ACTION,U,7))_" on "_$$DATE($P(ACTION,U,16)) S CNT=CNT+1,@ORY@(CNT)="     Signature:         "_$$SIG($P(ACTION,U,4)) ;186
    39         I $P(ACTION,U,9) S CNT=CNT+1,@ORY@(CNT)="     Nurse Verified:    "_$S($P(ACTION,U,8):$$USER(+$P(ACTION,U,8))_" on ",1:"")_$$DATE($P(ACTION,U,9))
    40         I $P(ACTION,U,11) S CNT=CNT+1,@ORY@(CNT)="     Clerk Verified:    "_$S($P(ACTION,U,10):$$USER(+$P(ACTION,U,10))_" on ",1:"")_$$DATE($P(ACTION,U,11))
    41         I $P(ACTION,U,19) S CNT=CNT+1,@ORY@(CNT)="     Chart Reviewed:    "_$S($P(ACTION,U,18):$$USER(+$P(ACTION,U,18))_" on ",1:"")_$$DATE($P(ACTION,U,19))
    42 A3      I $P(ACTION,U,2)="DC",$L(OR6) S X=$S($L($P(OR6,U,5)):$P(OR6,U,5),$P(OR6,U,4):$P($G(^ORD(100.03,+$P(OR6,U,4),0)),U),$P(OR6,U):$P($G(^ORD(100.02,+$P(OR6,U),0)),U),1:"") S:$L(X) CNT=CNT+1,@ORY@(CNT)="     Reason for DC:     "_X
    43         I $L($G(^OR(100,ORIFN,8,ORI,1))) S X=^(1) D  ;add backdoor comments
    44         . N LBL,I S LBL=""
    45         . I $P(ACTION,U,15)="",$P(ACTION,U,2)'="DC" S LBL="     Comments:          " ;DC shown above
    46         . I $P(ACTION,U,15)=13,$P(ACTION,U,2)'="NW" S LBL="     Cancelled:         " ;NW shown in ORQ2
    47         . Q:'$L(LBL)  I $L(X)'>56 S CNT=CNT+1,@ORY@(CNT)=LBL_X Q
    48         . S DIWL=1,DIWR=56,DIWF="C56" K ^UTILITY($J,"W") D ^DIWP
    49         . S I=0 F  S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=LBL_^(I,0),LBL="                        "
    50         I $D(^OR(100,ORIFN,8,ORI,5)) D  ;Ward comments
    51         . N X,ORJ K ^UTILITY($J,"W")
    52         . S ORJ=0 F  S ORJ=$O(^OR(100,ORIFN,8,ORI,5,ORJ)) Q:ORJ'>0  S X=^(ORJ,0) D ^DIWP
    53         . S ORJ=0 F  S ORJ=$O(^UTILITY($J,"W",DIWL,ORJ)) Q:ORJ'>0  S CNT=CNT+1,@ORY@(CNT)=$S(ORJ=1:"     Ward/Clinic Cmmts: ",1:"                        ")_^(ORJ,0)
    54         . K ^UTILITY($J,"W")
    55 A4      I $P(ACTION,U,2)="HD",$G(^OR(100,ORIFN,8,ORI,2)) S X2=^(2),CNT=CNT+1,@ORY@(CNT)="     Hold Released:     "_$$FMTE^XLFDT($P(X2,U),"2P")_" by "_$$USER($P(X2,U,2))
    56         I $D(^OR(100,ORIFN,8,ORI,3)) D  ;Un-/Flagged
    57         . N X S X=$G(^OR(100,ORIFN,8,ORI,3))
    58         . S CNT=CNT+1,@ORY@(CNT)="     Flagged by:        "_$$USER(+$P(X,U,4))_" on "_$$DATE($P(X,U,3))
    59         . S CNT=CNT+1,@ORY@(CNT)="                        "_$P(X,U,5)
    60         . Q:X  S CNT=CNT+1,@ORY@(CNT)="     Unflagged by:      "_$$USER(+$P(X,U,7))_" on "_$$DATE($P(X,U,6))
    61         . S CNT=CNT+1,@ORY@(CNT)="                        "_$P(X,U,8)
    62         Q
    63         ;
    64 DC      ; -- Add Reason for DC
    65         S CNT=CNT+1,@ORY@(CNT)=$$DATE($P(OR6,U,3))_$S($P(OR6,U,8):"  Auto-",1:"  ")_"Discontinued"
    66         I $P(OR6,U,8) D  Q
    67         . N EVT,PKG,ORV,I
    68         . S EVT=$P(OR6,U,8),PKG=$P($G(^ORE(100.2,+EVT,3,ORIFN,0)),U,2)
    69         . S @ORY@(CNT)=@ORY@(CNT)_" by "_$S(PKG="FH":"DIETETICS",PKG="LR":"LABORATORY",PKG="PS":"PHARMACY",1:"CPRS")
    70         . D EVENT(.ORV,1) S CNT=CNT+1,@ORY@(CNT)="     Patient Movement:  "_ORV(1)
    71         . S I=1 F  S I=$O(ORV(I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORV(I))
    72         I $P(OR6,U,2),$P($G(^ORD(100.02,+$P(OR6,U),0)),U,2)'="A" S @ORY@(CNT)=@ORY@(CNT)_" by "_$$USER($P(OR6,U,2)) ;don't show user name if auto-dc
    73         N X S X=$S($L($P(OR6,U,5)):$P(OR6,U,5),$P(OR6,U,4):$P($G(^ORD(100.03,+$P(OR6,U,4),0)),U),$P(OR6,U):$P($G(^ORD(100.02,+$P(OR6,U),0)),U),1:"") S:$L(X) CNT=CNT+1,@ORY@(CNT)="     Reason for DC:     "_X
    74         Q
    75         ;
    76 ACTION(CODE)    ; -- Return name of action CODE
    77         N NAME S NAME=$S(CODE="NW":"New Order",CODE="DC":"Discontinue",CODE="HD":"Hold",CODE="RL":"Release Hold",CODE="RN":"Renewal",CODE="XX":"Change",1:"")
    78         I CODE="NW",$P(OR3,U,11) S NAME=NAME_$S($P(OR3,U,11)=1:" (Change)",$P(OR3,U,11)=2:" (Renewal)",1:"")
    79         Q NAME
    80         ;
    81 XACT(X) ; -- Return name of transaction code X
    82         N Y S X=$G(X)
    83         S Y=$S(X="XX":"Edited",X="DC":"Discontinued",X="HD":"Held",X="RL":"Hold Released",X="FW":"Forwarded",X="CA":"Cancelled",1:"")
    84         Q Y
    85         ;
    86 DATE(X) ; -- Return date formatted as 00/00/0000 00:00
    87         N T,Y  S T=$P(X,".",2)_"0000"
    88         S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))
    89         I T S Y=Y_" "_$E(T,1,2)_":"_$E(T,3,4)
    90         Q Y
    91         ;
    92 USER(X) ; -- Returns NAME (TITLE) of New Person X
    93         N X0,Y S X0=$G(^VA(200,+X,0)),Y=$P(X0,U)
    94         S:$P(X0,U,9) Y=Y_" ("_$E($P($G(^DIC(3.1,+$P(X0,U,9),0)),U),1,15)_")"
    95         Q Y
    96         ;
    97 SIG(X)  ; -- Returns text of signature status X
    98         N Y S Y=""
    99         I X=0 S Y="ON CHART WITH WRITTEN ORDERS"
    100         I X=1 S Y="ELECTRONICALLY SIGNED"
    101         I X=2 S Y="NOT SIGNED"
    102         I X=3 S Y="NOT REQUIRED"
    103         I X=4 S Y="ON CHART WITH PRINTED ORDERS"
    104         I X=5 S Y="NOT REQUIRED DUE TO SERVICE CANCEL/LAPSE"
    105         I X=6 S Y="SERVICE CORRECTION TO SIGNED ORDER"
    106         Q Y
    107         ;
    108 SERVCORR()      ; -- Returns 1 or 0, if current ACTION is a serv corr change
    109         N Y,NATURE,I,X S Y=0
    110         G:ORACT'="XX" SCQ
    111         S NATURE=+$P(ACTION,U,12),NATURE=$P($G(^ORD(100.02,NATURE,0)),U,2)
    112         I "^S^I^"'[(U_NATURE_U) G SCQ
    113         S I=$O(^OR(100,ORIFN,8,ORI),-1),X=$G(^(I,0))
    114         I $P(X,U,3)'=$P(ACTION,U,3),$P(X,U,5)'=$P(ACTION,U,3) G SCQ ;show prov
    115         S Y=1
    116 SCQ     Q Y
    117         ;
    118 EVENT(ORTX,DC)  ; -- Returns patient event info for EVT
    119         N EVT1,REL,X,Y,I,ORMAX
    120         S ORTX(1)="" ;177
    121         S EVT1=$G(^ORE(100.2,EVT,1)),REL=$G(^ORE(100.2,EVT,2,ORIFN,0))
    122         ; Return event data if AutoDC or auto-released by an event:
    123         I $G(DC)!(REL&'$L($P(REL,U,2))&($P(EVT1,U,2)!$P(EVT1,U,4))) D  Q
    124         . S Y=$S($P(EVT1,U,5):$P(EVT1,U,5),1:EVT) ;parent owns Activity
    125         . S Y=+$O(^ORE(100.2,+Y,10,0)),Y=$G(^(Y,0)),X=$P(Y,U,4) Q:'$L(X)
    126         . S X=$S(X="A":"ADMISSION",X="T":"TRANSFER",X="D":"DISCHARGE",X="S":"SPECIALTY CHANGE",1:$S($P(EVT1,U)>$$DPI^ORUTL1("SR*3.0*157"):"IN TO O.R.",1:"OUT OF O.R."))_" on "_$$DATE($P(EVT1,U)) ;243
    127         . S ORTX(1)=X,ORTX=1,ORMAX=56
    128         . I $P(Y,U,6) S X=$S($P(Y,U,4)="D":"from ",1:"to ")_$$GET1^DIQ(45.7,+$P(Y,U,6)_",",.01) D TXT^ORCHTAB
    129         . I $P(Y,U,7) S X="on "_$$GET1^DIQ(42,+$P(Y,U,7)_",",.01) D TXT^ORCHTAB
    130         S X=$$USER(+$P(ACTION,U,17))_" on "_$$DATE($P(ACTION,U,16))
    131         I ORIFN'=+$P($G(^ORE(100.2,EVT,0)),U,4),$P(REL,U,2)="MN" S X=X_" (manually released)"
    132         S ORTX(1)=X
    133         Q
     1ORQ20 ; SLC/MKB - Detailed Order Report cont ;7/23/03  12:29
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,27,92,94,116,141,177,186,190,215**;Dec 17, 1997
     3ACT ; -- add Activity [from ^ORQ2]
     4 N ORACT S ORACT=$P(ACTION,U,2)
     5 N NVA S:$P(^ORD(100.98,$P(^OR(100,+ORIFN,0),U,11),0),U)="NON-VA MEDICATIONS" NVA=1
     6 S CNT=CNT+1,@ORY@(CNT)=$$DATE($P(ACTION,U))_"  "_$$ACTION(ORACT)
     7 I $P(ACTION,U,13) S @ORY@(CNT)=@ORY@(CNT)_" entered by "_$$USER(+$P(ACTION,U,13))
     8 I ORACT="NW" D  ;Show original order text
     9 . N ORZ,I,ORIGVIEW S ORIGVIEW=2 D TEXT^ORQ12(.ORZ,ORIFN_";1",80)
     10 . S CNT=CNT+1,@ORY@(CNT)="     Order Text:        "_$G(ORZ(1))
     11 . S I=1 F  S I=$O(ORZ(I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORZ(I))
     12 I ORACT="XX" D  ;Changed - show new text
     13 . N ORZ,I,ORIGVIEW S ORIGVIEW=2 D TEXT^ORQ12(.ORZ,ORIFN_";"_ORI,80)
     14 . S CNT=CNT+1,@ORY@(CNT)="     Changed to:        "_$G(ORZ(1))
     15 . S I=1 F  S I=$O(ORZ(I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORZ(I))
     16A1 I $P(ACTION,U,12) D  ;Nature of Order/Release
     17 . N ORZ S ORZ=$G(^ORD(100.02,+$P(ACTION,U,12),0))
     18 . S CNT=CNT+1,@ORY@(CNT)="     Nature of Order:   "_$P(ORZ,U)
     19 . I $P(OR0,U,17),(ORACT="NW") Q  ;see event
     20 . I "^V^P^"[(U_$P(ORZ,U,2)_U),$P(ACTION,U,16) S CNT=CNT+1,@ORY@(CNT)="     Released by:       "_$$USER(+$P(ACTION,U,17))_" on "_$$DATE($P(ACTION,U,16))
     21 I $P(OR0,U,17)&(ORACT="NW") D  ;Delayed Release Event
     22 . N EVT,X,ORV,I S EVT=+$P(OR0,U,17),X=$$NAME^OREVNTX(EVT)
     23 . S:$E(X,1,8)="Delayed " X=$E(X,9,99)
     24 . I $G(^ORE(100.2,EVT,1)),'$P(ACTION,U,16) S X=X_" on "_$$DATE(+^(1))
     25 . S CNT=CNT+1,@ORY@(CNT)="     Delayed Until:     "_X Q:'$P(ACTION,U,16)
     26 . D EVENT(.ORV) S CNT=CNT+1,@ORY@(CNT)="     Released by:       "_ORV(1)
     27 . S I=1 F  S I=$O(ORV(I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORV(I))
     28A2 I $P(ACTION,U,5) S CNT=CNT+1,@ORY@(CNT)=$S($P(ACTION,U,4)=7:"      Dig",1:"     Elec")_" Signature:    "_$$USER(+$P(ACTION,U,5))_" on "_$$DATE($P(ACTION,U,6))
     29 I '$P(ACTION,U,5)!($P(ACTION,U,3)'=$P(ACTION,U,5)),'$$SERVCORR S CNT=CNT+1,@ORY@(CNT)="     "_$S($D(NVA):"Documented by:",1:"Ordered by:   ")_"     "_$$USER(+$P(ACTION,U,3))
     30 I '$P(ACTION,U,5),$L($P(ACTION,U,4)) S:$P(ACTION,U,4)=0 CNT=CNT+1,@ORY@(CNT)="     Released by:       "_$$USER(+$P(ACTION,U,7))_" on "_$$DATE($P(ACTION,U,16)) S CNT=CNT+1,@ORY@(CNT)="     Signature:         "_$$SIG($P(ACTION,U,4)) ;186
     31 I $P(ACTION,U,9) S CNT=CNT+1,@ORY@(CNT)="     Nurse Verified:    "_$S($P(ACTION,U,8):$$USER(+$P(ACTION,U,8))_" on ",1:"")_$$DATE($P(ACTION,U,9))
     32 I $P(ACTION,U,11) S CNT=CNT+1,@ORY@(CNT)="     Clerk Verified:    "_$S($P(ACTION,U,10):$$USER(+$P(ACTION,U,10))_" on ",1:"")_$$DATE($P(ACTION,U,11))
     33 I $P(ACTION,U,19) S CNT=CNT+1,@ORY@(CNT)="     Chart Reviewed:    "_$S($P(ACTION,U,18):$$USER(+$P(ACTION,U,18))_" on ",1:"")_$$DATE($P(ACTION,U,19))
     34A3 I $P(ACTION,U,2)="DC",$L(OR6) S X=$S($L($P(OR6,U,5)):$P(OR6,U,5),$P(OR6,U,4):$P($G(^ORD(100.03,+$P(OR6,U,4),0)),U),$P(OR6,U):$P($G(^ORD(100.02,+$P(OR6,U),0)),U),1:"") S:$L(X) CNT=CNT+1,@ORY@(CNT)="     Reason for DC:     "_X
     35 I $L($G(^OR(100,ORIFN,8,ORI,1))) S X=^(1) D  ;add backdoor comments
     36 . N LBL,I S LBL=""
     37 . I $P(ACTION,U,15)="",$P(ACTION,U,2)'="DC" S LBL="     Comments:          " ;DC shown above
     38 . I $P(ACTION,U,15)=13,$P(ACTION,U,2)'="NW" S LBL="     Cancelled:         " ;NW shown in ORQ2
     39 . Q:'$L(LBL)  I $L(X)'>56 S CNT=CNT+1,@ORY@(CNT)=LBL_X Q
     40 . S DIWL=1,DIWR=56,DIWF="C56" K ^UTILITY($J,"W") D ^DIWP
     41 . S I=0 F  S I=$O(^UTILITY($J,"W",DIWL,I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=LBL_^(I,0),LBL="                        "
     42 I $D(^OR(100,ORIFN,8,ORI,5)) D  ;Ward comments
     43 . N X,ORJ K ^UTILITY($J,"W")
     44 . S ORJ=0 F  S ORJ=$O(^OR(100,ORIFN,8,ORI,5,ORJ)) Q:ORJ'>0  S X=^(ORJ,0) D ^DIWP
     45 . S ORJ=0 F  S ORJ=$O(^UTILITY($J,"W",DIWL,ORJ)) Q:ORJ'>0  S CNT=CNT+1,@ORY@(CNT)=$S(ORJ=1:"     Ward/Clinic Cmmts: ",1:"                        ")_^(ORJ,0)
     46 . K ^UTILITY($J,"W")
     47A4 I $P(ACTION,U,2)="HD",$G(^OR(100,ORIFN,8,ORI,2)) S X2=^(2),CNT=CNT+1,@ORY@(CNT)="     Hold Released:     "_$$FMTE^XLFDT($P(X2,U),"2P")_" by "_$$USER($P(X2,U,2))
     48 I $D(^OR(100,ORIFN,8,ORI,3)) D  ;Un-/Flagged
     49 . N X S X=$G(^OR(100,ORIFN,8,ORI,3))
     50 . S CNT=CNT+1,@ORY@(CNT)="     Flagged by:        "_$$USER(+$P(X,U,4))_" on "_$$DATE($P(X,U,3))
     51 . S CNT=CNT+1,@ORY@(CNT)="                        "_$P(X,U,5)
     52 . Q:X  S CNT=CNT+1,@ORY@(CNT)="     Unflagged by:      "_$$USER(+$P(X,U,7))_" on "_$$DATE($P(X,U,6))
     53 . S CNT=CNT+1,@ORY@(CNT)="                        "_$P(X,U,8)
     54 Q
     55 ;
     56DC ; -- Add Reason for DC
     57 S CNT=CNT+1,@ORY@(CNT)=$$DATE($P(OR6,U,3))_$S($P(OR6,U,8):"  Auto-",1:"  ")_"Discontinued"
     58 I $P(OR6,U,8) D  Q
     59 . N EVT,PKG,ORV,I
     60 . S EVT=$P(OR6,U,8),PKG=$P($G(^ORE(100.2,+EVT,3,ORIFN,0)),U,2)
     61 . S @ORY@(CNT)=@ORY@(CNT)_" by "_$S(PKG="FH":"DIETETICS",PKG="LR":"LABORATORY",PKG="PS":"PHARMACY",1:"CPRS")
     62 . D EVENT(.ORV,1) S CNT=CNT+1,@ORY@(CNT)="     Patient Movement:  "_ORV(1)
     63 . S I=1 F  S I=$O(ORV(I)) Q:I'>0  S CNT=CNT+1,@ORY@(CNT)=$$REPEAT^XLFSTR(" ",24)_$G(ORV(I))
     64 I $P(OR6,U,2),$P($G(^ORD(100.02,+$P(OR6,U),0)),U,2)'="A" S @ORY@(CNT)=@ORY@(CNT)_" by "_$$USER($P(OR6,U,2)) ;don't show user name if auto-dc
     65 N X S X=$S($L($P(OR6,U,5)):$P(OR6,U,5),$P(OR6,U,4):$P($G(^ORD(100.03,+$P(OR6,U,4),0)),U),$P(OR6,U):$P($G(^ORD(100.02,+$P(OR6,U),0)),U),1:"") S:$L(X) CNT=CNT+1,@ORY@(CNT)="     Reason for DC:     "_X
     66 Q
     67 ;
     68ACTION(CODE) ; -- Return name of action CODE
     69 N NAME S NAME=$S(CODE="NW":"New Order",CODE="DC":"Discontinue",CODE="HD":"Hold",CODE="RL":"Release Hold",CODE="RN":"Renewal",CODE="XX":"Change",1:"")
     70 I CODE="NW",$P(OR3,U,11) S NAME=NAME_$S($P(OR3,U,11)=1:" (Change)",$P(OR3,U,11)=2:" (Renewal)",1:"")
     71 Q NAME
     72 ;
     73XACT(X) ; -- Return name of transaction code X
     74 N Y S X=$G(X)
     75 S Y=$S(X="XX":"Edited",X="DC":"Discontinued",X="HD":"Held",X="RL":"Hold Released",X="FW":"Forwarded",X="CA":"Cancelled",1:"")
     76 Q Y
     77 ;
     78DATE(X) ; -- Return date formatted as 00/00/0000 00:00
     79 N T,Y  S T=$P(X,".",2)_"0000"
     80 S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))
     81 I T S Y=Y_" "_$E(T,1,2)_":"_$E(T,3,4)
     82 Q Y
     83 ;
     84USER(X) ; -- Returns NAME (TITLE) of New Person X
     85 N X0,Y S X0=$G(^VA(200,+X,0)),Y=$P(X0,U)
     86 S:$P(X0,U,9) Y=Y_" ("_$E($P($G(^DIC(3.1,+$P(X0,U,9),0)),U),1,15)_")"
     87 Q Y
     88 ;
     89SIG(X) ; -- Returns text of signature status X
     90 N Y S Y=""
     91 I X=0 S Y="ON CHART WITH WRITTEN ORDERS"
     92 I X=1 S Y="ELECTRONICALLY SIGNED"
     93 I X=2 S Y="NOT SIGNED"
     94 I X=3 S Y="NOT REQUIRED"
     95 I X=4 S Y="ON CHART WITH PRINTED ORDERS"
     96 I X=5 S Y="NOT REQUIRED DUE TO SERVICE CANCEL"
     97 I X=6 S Y="SERVICE CORRECTION TO SIGNED ORDER"
     98 Q Y
     99 ;
     100SERVCORR()      ; -- Returns 1 or 0, if current ACTION is a serv corr change
     101 N Y,NATURE,I,X S Y=0
     102 G:ORACT'="XX" SCQ
     103 S NATURE=+$P(ACTION,U,12),NATURE=$P($G(^ORD(100.02,NATURE,0)),U,2)
     104 I "^S^I^"'[(U_NATURE_U) G SCQ
     105 S I=$O(^OR(100,ORIFN,8,ORI),-1),X=$G(^(I,0))
     106 I $P(X,U,3)'=$P(ACTION,U,3),$P(X,U,5)'=$P(ACTION,U,3) G SCQ ;show prov
     107 S Y=1
     108SCQ Q Y
     109 ;
     110EVENT(ORTX,DC) ; -- Returns patient event info for EVT
     111 N EVT1,REL,X,Y,I,ORMAX
     112 S ORTX(1)="" ;177
     113 S EVT1=$G(^ORE(100.2,EVT,1)),REL=$G(^ORE(100.2,EVT,2,ORIFN,0))
     114 ; Return event data if AutoDC or auto-released by an event:
     115 I $G(DC)!(REL&'$L($P(REL,U,2))&($P(EVT1,U,2)!$P(EVT1,U,4))) D  Q
     116 . S Y=$S($P(EVT1,U,5):$P(EVT1,U,5),1:EVT) ;parent owns Activity
     117 . S Y=+$O(^ORE(100.2,+Y,10,0)),Y=$G(^(Y,0)),X=$P(Y,U,4) Q:'$L(X)
     118 . S X=$S(X="A":"ADMISSION",X="T":"TRANSFER",X="D":"DISCHARGE",X="S":"SPECIALTY CHANGE",1:"OUT OF O.R.")_" on "_$$DATE($P(EVT1,U))
     119 . S ORTX(1)=X,ORTX=1,ORMAX=56
     120 . I $P(Y,U,6) S X=$S($P(Y,U,4)="D":"from ",1:"to ")_$$GET1^DIQ(45.7,+$P(Y,U,6)_",",.01) D TXT^ORCHTAB
     121 . I $P(Y,U,7) S X="on "_$$GET1^DIQ(42,+$P(Y,U,7)_",",.01) D TXT^ORCHTAB
     122 S X=$$USER(+$P(ACTION,U,17))_" on "_$$DATE($P(ACTION,U,16))
     123 I ORIFN'=+$P($G(^ORE(100.2,EVT,0)),U,4),$P(REL,U,2)="MN" S X=X_" (manually released)"
     124 S ORTX(1)=X
     125 Q
Note: See TracChangeset for help on using the changeset viewer.