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

    r613 r623  
    1 ORQ12   ; slc/dcm - Get patient orders in context ;06/29/06
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,27,78,92,116,190,220,215,243**;Dec 17, 1997;Build 242
    3 GET(IFN,NEWD,DETAIL,ACTOR)      ; -- Setup TMP array
    4         ; IFN=ifn of order
    5         ; NEWD=3rd subscript in ^TMP("ORR",$J, node (ORLIST)
    6         ; DETAIL=see description in ^ORQ1
    7         ;
    8         N X0,X3,X4,X6,TXT,STAT,START,DG,STOP,ENTERD
    9         S ORLST=ORLST+1,^TMP("ORGOTIT",$J,IFN,+$G(ACTOR))=""
    10         I '$G(DETAIL) S ^TMP("ORR",$J,NEWD,ORLST)=IFN_$S($G(ACTOR):";"_ACTOR,1:"") Q
    11         S X0=^OR(100,IFN,0),X3=$G(^(3)),X4=$G(^(4)),X6=$G(^(6))
    12         S DG=$P(X0,U,11),DG=$P($G(^ORD(100.98,+DG,0)),U,3)
    13         S STAT=$S($P(X3,U,3):$P(^ORD(100.01,$P(X3,U,3),0),U,1,2),1:"") ;.01^abbr
    14         S ENTERD=$P(X0,U,7),START=$P(X0,U,8),STOP=$P(X0,U,9)
    15         ; S FLAGREA=$P(X6,U,7)
    16         S ^TMP("ORR",$J,NEWD,ORLST)=IFN_$S($G(ACTOR):";"_ACTOR,1:"")_U_DG_U_ENTERD_U_START_U_STOP_U_STAT
    17         D TEXT(.TXT,IFN) M ^TMP("ORR",$J,NEWD,ORLST,"TX")=TXT
    18         Q
    19         ;
    20 TEXT(ORTX,ORIFN,WIDTH)  ; -- Returns text of order ORIFN in ORTX(#)
    21         N OR0,OR3,OR6,X,Y,FIRST,ORI,ORJ,DLG,ORX,ORACT,ORTA
    22         K ORTX S:'$G(WIDTH) WIDTH=244
    23         S ORACT=+$P(ORIFN,";",2),ORIFN=+ORIFN
    24         I ORACT<1 S ORACT=+$P($G(^OR(100,ORIFN,3)),U,7) S:'ORACT ORACT=1
    25         ;D:$O(^OR(100,ORIFN,1,0)) CNV^ORY92(ORIFN) ;convert text otf
    26         S OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR6=$G(^(6)),ORX=$G(^(8,ORACT,0))
    27         S ORTX=1,ORTX(1)=""
    28         I $P($G(OR0),U,11)'="",($P(^ORD(100.98,$P(OR0,U,11),0),U)="NON-VA MEDICATIONS") S X="Non-VA" D ADD
    29         G:$G(ORIGVIEW)>1 T1
    30         S:$P(OR0,U,14)=$O(^DIC(9.4,"C","OR",0)) ORTX(1)=">>" ;generic
    31         S X=$$ACTION($P(ORX,U,2)) D:$L(X) ADD
    32         I $P(ORX,U,2)="NW",$P(OR3,U,11),'$G(ORIGVIEW) D  ; Changed or Renewed
    33         . I $P(OR3,U,11)=2 S X="Renew" D ADD Q
    34         . N ORIG,ORIGTA S ORIG=+$P(OR3,U,5) Q:'ORIG  Q:$P(OR3,U,11)'=1
    35         . S X="Change" D ADD S ORI=0
    36         . I $G(IOST)'="P-OTHER" D
    37         . .S ORIGTA=$$LASTXT(ORIG) ;D:$O(^OR(100,ORIG,1,0)) CNV^ORY92(ORIG)
    38         . .F  S ORI=$O(^OR(100,ORIG,8,ORIGTA,.1,ORI)) Q:ORI'>0  S X=$G(^(ORI,0)) S:$E(X,1,3)=">> " X=$E(X,4,999) D ADD
    39         . .S X=" to" D ADD
    40 T1      S ORTA=+$P(ORX,U,14),FIRST=+$O(^OR(100,ORIFN,8,ORTA,.1,0))
    41         S ORI=0 F  S ORI=$O(^OR(100,ORIFN,8,ORTA,.1,ORI)) Q:ORI'>0  S X=$G(^(ORI,0)) S:(FIRST=ORI)&($E(X,1,3)=">> ") X=$E(X,4,999) D:$L(X) ADD
    42         Q:$G(ORIGVIEW)>1  ;contents of global only
    43         S DLG=$P(OR0,U,5) K Y I DLG,$P(DLG,";",2)["101.41",$D(^ORD(101.41,+DLG,9)) X ^(9) I $L($G(Y)) S X=Y D ADD ; additional text
    44         ; I $P(OR3,U,11)=2 S X="(Renewal)" D ADD
    45         I $P(ORX,U,4)=2 S X="*UNSIGNED*" D ADD
    46         I $P(ORX,U,2)="DC"!("^1^13^"[(U_$P(OR3,U,3)_U)),$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),1:"")_">" D:$L(X)>3 ADD ; DC Reason
    47         I $D(XQAID),$G(ORFLG)=12 S ORX=$G(^OR(100,ORIFN,8,ORACT,3)) I $P(ORX,U) S X=" Flagged "_$$DATETIME($P(ORX,U,3))_$S($P(ORX,U,4):" by "_$$NAME($P(ORX,U,4)),1:"")_": "_$P(ORX,U,5) D ADD ; Flagged - show in FUP
    48         Q
    49         ;
    50 LASTXT(IFN)         ; -- Returns action with latest text for order IFN
    51         N I,Y S Y=1
    52         S I=0 F  S I=$O(^OR(100,IFN,8,I)) Q:I'>0  S:$O(^(I,.1,0)) Y=I
    53         Q Y
    54         ;
    55 LAST(CODE)      ; -- Return DA of last occurence of CODE action
    56         N DA
    57         I '$L($G(CODE)) S DA=$O(^OR(100,ORIFN,8,"A"),-1) ; last entry
    58         E  S DA=$O(^OR(100,ORIFN,8,"C",CODE,"?"),-1) ; last CODE entry
    59         Q DA
    60         ;
    61 ACTION(X)       ; -- Returns text of action X
    62         N Y
    63         S Y=$S(X="DC":"Discontinue",X="HD":"Hold",X="RL"&'$G(ORIGVIEW):"Release Hold of",X="FL":"Flag",X="UF":"Unflag",X="RN"&'$G(ORIGVIEW):"Renew",1:"")
    64         Q Y
    65         ;
    66 DATETIME(X)     ; -- Returns date/time in format 00/00/00@00:00am
    67         N Y,D,T,T1,Z
    68         S D=$P(X,"."),T=$E($P(X,".",2)_"0000",1,4),T1=$E(T,1,2),Z="AM"
    69         S:T1>12 T1=T1-12,Z="PM"
    70         S Y=$E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))_"@"_T1_":"_$E(T,3,4)_Z
    71         Q Y
    72         ;
    73 NAME(X) ; -- Returns name as Lname,F
    74         N Y,Z S Z=$P($G(^VA(200,+X,0)),U) Q:Z="" ""
    75         S Y=$P(Z,",")_"," F I=$F(Z,","):1:$L(Z) I $E(Z,I)'=" " S Y=Y_$E(Z,I) Q
    76         S Y=$$LOWER^VALM1(Y) ; mixed case
    77         Q Y
    78         ;
    79 ADD     ; -- Add text X to ORTX()
    80         N I,Y S Y=$L(ORTX(ORTX)) S:Y Y=Y+1 ;allow for space
    81         I $E(X)=" ",Y S ORTX=ORTX+1,ORTX(ORTX)="",Y=0,X=$E(X,2,999) ;new line
    82         I Y+$L(X)'>WIDTH S ORTX(ORTX)=ORTX(ORTX)_$S(Y:" ",1:"")_X Q
    83         F I=1:1:$L(X," ") S Z=$P(X," ",I) D:(Y+$L(Z))>WIDTH  S ORTX(ORTX)=$G(ORTX(ORTX))_$S(Y:" ",1:"")_Z,Y=$L(ORTX(ORTX)) S:Y Y=Y+1
    84         . I $L(Z)>WIDTH F  S ORTX(ORTX)=$G(ORTX(ORTX))_$S(Y:" ",1:"")_$E(Z,1,WIDTH-Y),Z=$E(Z,WIDTH-Y+1,999) Q:$L(Z)'>WIDTH  S ORTX=ORTX+1,Y=0
    85         . S ORTX=ORTX+1,Y=0
    86         Q
    87         ;
    88 EXPD    ; -- loop through ^XTMP("ORAE" to get expired orders
    89         K ^TMP("ORGOTIT",$J),^TMP("ORSORT",$J)
    90         N TM,TO,IFN,X0,X3,X7,X8,USTS,NOW,ACTOR,X,ORREP
    91         S NOW=+$E($$NOW^XLFDT,1,12),TO=0,SDATE=9999999-SDATE,EDATE=9999999-EDATE
    92         F  S TO=$O(^XTMP("ORAE",PAT,TO)) Q:'TO  I $D(ORGRP(TO)) S TM=EDATE F  S TM=$O(^XTMP("ORAE",PAT,TO,TM)) Q:'TM!(TM>SDATE)!(+TM<EDATE)  D
    93         . S IFN=0 F  S IFN=$O(^XTMP("ORAE",PAT,TO,TM,IFN)) Q:'IFN  I ('$D(^TMP("ORGOTIT",$J,IFN))!MULT) D
    94         .. S USTS=$P(^OR(100,IFN,3),U,3)
    95         .. Q:+$G(USTS)'=7  ;quit if order no longer expired
    96         .. S ORREP=$P(^OR(100,IFN,3),U,6)
    97         .. Q:+$G(ORREP)>0  ;quit if order has been replaced
    98         .. S ^TMP("ORSORT",$J,9999999-TM,TO,IFN)=""
    99         S TM=0 F  S TM=$O(^TMP("ORSORT",$J,TM)) Q:'TM  S TO=0 F  S TO=$O(^TMP("ORSORT",$J,TM,TO)) Q:'TO  D
    100         .S IFN=0 F  S IFN=$O(^TMP("ORSORT",$J,TM,TO,IFN)) Q:'IFN  I $D(^OR(100,IFN,0)),$D(^(3)) S X0=^(0),X3=^(3) D
    101         ..S ACTOR=+$P(X3,U,7) D LP1^ORQ11
    102         ..;S ACTOR=0 F  S ACTOR=$O(^OR(100,"ACT",PAT,9999999-$P(X0,U,7),TO,IFN,ACTOR)) Q:ACTOR<1  I '$D(^TMP("ORGOTIT",$J,IFN,ACTOR)),$D(^OR(100,IFN,8,ACTOR,0)),$P(^(0),U,15)'=13 S X8=^(0),X7=$G(^(7)) D LP1^ORQ11
    103         S ^TMP("ORR",$J,ORLIST,"TOT")=$G(ORLST)
    104         K ^TMP("ORSORT",$J),^TMP("ORGOTIT",$J)
    105         Q
    106 GETEIE(IFN,NEWD,DETAIL,ACTOR)   ; -- Setup TMP array
    107         ; IFN=ifn of order
    108         ; NEWD=3rd subscript in ^TMP("ORR",$J, node (ORLIST)
    109         ; DETAIL=see description in ^ORQ1
    110         ;
    111         N X0,X3,X4,X6,TXT,STAT,START,DG,STOP,ENTERD,DCREAS
    112         S X0=^OR(100,IFN,0),X3=$G(^(3)),X4=$G(^(4)),X6=$G(^(6))
    113         S DG=$P(X0,U,11),DG=$P($G(^ORD(100.98,+DG,0)),U,3)
    114         S STAT=$S($P(X3,U,3):$P(^ORD(100.01,$P(X3,U,3),0),U,1,2),1:"")
    115         S ENTERD=$P(X0,U,7),START=$P(X0,U,8),STOP=$P(X0,U,9)
    116         S DCREAS=$P($G(X6),U,4) Q:DCREAS'>0
    117         I DCREAS'=$O(^ORD(100.03,"B","Entered in error","")) Q
    118         S ORLST=ORLST+1,^TMP("ORGOTIT",$J,IFN,+$G(ACTOR))=""
    119         I '$G(DETAIL) S ^TMP("ORR",$J,NEWD,ORLST)=IFN_$S($G(ACTOR):";"_ACTOR,1:"") Q
    120         S ^TMP("ORR",$J,NEWD,ORLST)=IFN_$S($G(ACTOR):";"_ACTOR,1:"")_U_DG_U_ENTERD_U_START_U_STOP_U_STAT
    121         D TEXT(.TXT,IFN) M ^TMP("ORR",$J,NEWD,ORLST,"TX")=TXT
    122         Q
     1ORQ12 ; slc/dcm - Get patient orders in context ;12/19/05
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**12,27,78,92,116,190,220,215**;Dec 17, 1997
     3GET(IFN,NEWD,DETAIL,ACTOR) ; -- Setup TMP array
     4 ; IFN=ifn of order
     5 ; NEWD=3rd subscript in ^TMP("ORR",$J, node (ORLIST)
     6 ; DETAIL=see description in ^ORQ1
     7 ;
     8 N X0,X3,X4,X6,TXT,STAT,START,DG,STOP,ENTERD
     9 S ORLST=ORLST+1,^TMP("ORGOTIT",$J,IFN,+$G(ACTOR))=""
     10 I '$G(DETAIL) S ^TMP("ORR",$J,NEWD,ORLST)=IFN_$S($G(ACTOR):";"_ACTOR,1:"") Q
     11 S X0=^OR(100,IFN,0),X3=$G(^(3)),X4=$G(^(4)),X6=$G(^(6))
     12 S DG=$P(X0,U,11),DG=$P($G(^ORD(100.98,+DG,0)),U,3)
     13 S STAT=$S($P(X3,U,3):$P(^ORD(100.01,$P(X3,U,3),0),U,1,2),1:"") ;.01^abbr
     14 S ENTERD=$P(X0,U,7),START=$P(X0,U,8),STOP=$P(X0,U,9)
     15 ; S FLAGREA=$P(X6,U,7)
     16 S ^TMP("ORR",$J,NEWD,ORLST)=IFN_$S($G(ACTOR):";"_ACTOR,1:"")_U_DG_U_ENTERD_U_START_U_STOP_U_STAT
     17 D TEXT(.TXT,IFN) M ^TMP("ORR",$J,NEWD,ORLST,"TX")=TXT
     18 Q
     19 ;
     20TEXT(ORTX,ORIFN,WIDTH) ; -- Returns text of order ORIFN in ORTX(#)
     21 N OR0,OR3,OR6,X,Y,FIRST,ORI,ORJ,DLG,ORX,ORACT,ORTA
     22 K ORTX S:'$G(WIDTH) WIDTH=244
     23 S ORACT=+$P(ORIFN,";",2),ORIFN=+ORIFN
     24 I ORACT<1 S ORACT=+$P($G(^OR(100,ORIFN,3)),U,7) S:'ORACT ORACT=1
     25 ;D:$O(^OR(100,ORIFN,1,0)) CNV^ORY92(ORIFN) ;convert text otf
     26 S OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR6=$G(^(6)),ORX=$G(^(8,ORACT,0))
     27 S ORTX=1,ORTX(1)=""
     28 I $P($G(OR0),U,11)'="",($P(^ORD(100.98,$P(OR0,U,11),0),U)="NON-VA MEDICATIONS") S X="Non-VA" D ADD
     29 G:$G(ORIGVIEW)>1 T1
     30 S:$P(OR0,U,14)=$O(^DIC(9.4,"C","OR",0)) ORTX(1)=">>" ;generic
     31 S X=$$ACTION($P(ORX,U,2)) D:$L(X) ADD
     32 I $P(ORX,U,2)="NW",$P(OR3,U,11),'$G(ORIGVIEW) D  ; Changed or Renewed
     33 . I $P(OR3,U,11)=2 S X="Renew" D ADD Q
     34 . N ORIG,ORIGTA S ORIG=+$P(OR3,U,5) Q:'ORIG  Q:$P(OR3,U,11)'=1
     35 . S X="Change" D ADD S ORI=0
     36 . I $G(IOST)'="P-OTHER" D
     37 . .S ORIGTA=$$LASTXT(ORIG) ;D:$O(^OR(100,ORIG,1,0)) CNV^ORY92(ORIG)
     38 . .F  S ORI=$O(^OR(100,ORIG,8,ORIGTA,.1,ORI)) Q:ORI'>0  S X=$G(^(ORI,0)) S:$E(X,1,3)=">> " X=$E(X,4,999) D ADD
     39 . .S X=" to" D ADD
     40T1 S ORTA=+$P(ORX,U,14),FIRST=+$O(^OR(100,ORIFN,8,ORTA,.1,0))
     41 S ORI=0 F  S ORI=$O(^OR(100,ORIFN,8,ORTA,.1,ORI)) Q:ORI'>0  S X=$G(^(ORI,0)) S:(FIRST=ORI)&($E(X,1,3)=">> ") X=$E(X,4,999) D:$L(X) ADD
     42 Q:$G(ORIGVIEW)>1  ;contents of global only
     43 S DLG=$P(OR0,U,5) K Y I DLG,$P(DLG,";",2)["101.41",$D(^ORD(101.41,+DLG,9)) X ^(9) I $L($G(Y)) S X=Y D ADD ; additional text
     44 ; I $P(OR3,U,11)=2 S X="(Renewal)" D ADD
     45 I $P(ORX,U,4)=2 S X="*UNSIGNED*" D ADD
     46 I $P(ORX,U,2)="DC"!("^1^13^"[(U_$P(OR3,U,3)_U)),$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),1:"")_">" D:$L(X)>3 ADD ; DC Reason
     47 I $D(XQAID),$G(ORFLG)=12 S ORX=$G(^OR(100,ORIFN,8,ORACT,3)) I $P(ORX,U) S X=" Flagged "_$$DATETIME($P(ORX,U,3))_$S($P(ORX,U,4):" by "_$$NAME($P(ORX,U,4)),1:"")_": "_$P(ORX,U,5) D ADD ; Flagged - show in FUP
     48 Q
     49 ;
     50LASTXT(IFN)     ; -- Returns action with latest text for order IFN
     51 N I,Y S Y=1
     52 S I=0 F  S I=$O(^OR(100,IFN,8,I)) Q:I'>0  S:$O(^(I,.1,0)) Y=I
     53 Q Y
     54 ;
     55LAST(CODE) ; -- Return DA of last occurence of CODE action
     56 N DA
     57 I '$L($G(CODE)) S DA=$O(^OR(100,ORIFN,8,"A"),-1) ; last entry
     58 E  S DA=$O(^OR(100,ORIFN,8,"C",CODE,"?"),-1) ; last CODE entry
     59 Q DA
     60 ;
     61ACTION(X) ; -- Returns text of action X
     62 N Y
     63 S Y=$S(X="DC":"Discontinue",X="HD":"Hold",X="RL"&'$G(ORIGVIEW):"Release Hold of",X="FL":"Flag",X="UF":"Unflag",X="RN"&'$G(ORIGVIEW):"Renew",1:"")
     64 Q Y
     65 ;
     66DATETIME(X) ; -- Returns date/time in format 00/00/00@00:00am
     67 N Y,D,T,T1,Z
     68 S D=$P(X,"."),T=$E($P(X,".",2)_"0000",1,4),T1=$E(T,1,2),Z="AM"
     69 S:T1>12 T1=T1-12,Z="PM"
     70 S Y=$E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))_"@"_T1_":"_$E(T,3,4)_Z
     71 Q Y
     72 ;
     73NAME(X) ; -- Returns name as Lname,F
     74 N Y,Z S Z=$P($G(^VA(200,+X,0)),U) Q:Z="" ""
     75 S Y=$P(Z,",")_"," F I=$F(Z,","):1:$L(Z) I $E(Z,I)'=" " S Y=Y_$E(Z,I) Q
     76 S Y=$$LOWER^VALM1(Y) ; mixed case
     77 Q Y
     78 ;
     79ADD ; -- Add text X to ORTX()
     80 N I,Y S Y=$L(ORTX(ORTX)) S:Y Y=Y+1 ;allow for space
     81 I $E(X)=" ",Y S ORTX=ORTX+1,ORTX(ORTX)="",Y=0,X=$E(X,2,999) ;new line
     82 I Y+$L(X)'>WIDTH S ORTX(ORTX)=ORTX(ORTX)_$S(Y:" ",1:"")_X Q
     83 F I=1:1:$L(X," ") S Z=$P(X," ",I) D:(Y+$L(Z))>WIDTH  S ORTX(ORTX)=$G(ORTX(ORTX))_$S(Y:" ",1:"")_Z,Y=$L(ORTX(ORTX)) S:Y Y=Y+1
     84 . I $L(Z)>WIDTH F  S ORTX(ORTX)=$G(ORTX(ORTX))_$S(Y:" ",1:"")_$E(Z,1,WIDTH-Y),Z=$E(Z,WIDTH-Y+1,999) Q:$L(Z)'>WIDTH  S ORTX=ORTX+1,Y=0
     85 . S ORTX=ORTX+1,Y=0
     86 Q
     87 ;
     88EXPD ; -- loop through ^XTMP("ORAE" to get expired orders
     89 K ^TMP("ORGOTIT",$J),^TMP("ORSORT",$J)
     90 N TM,TO,IFN,X0,X3,X7,X8,USTS,NOW,ACTOR,X,ORREP
     91 S NOW=+$E($$NOW^XLFDT,1,12),TO=0,SDATE=9999999-SDATE,EDATE=9999999-EDATE
     92 F  S TO=$O(^XTMP("ORAE",PAT,TO)) Q:'TO  I $D(ORGRP(TO)) S TM=EDATE F  S TM=$O(^XTMP("ORAE",PAT,TO,TM)) Q:'TM!(TM>SDATE)!(+TM<EDATE)  D
     93 . S IFN=0 F  S IFN=$O(^XTMP("ORAE",PAT,TO,TM,IFN)) Q:'IFN  I ('$D(^TMP("ORGOTIT",$J,IFN))!MULT) D
     94 .. S USTS=$P(^OR(100,IFN,3),U,3)
     95 .. Q:+$G(USTS)'=7  ;quit if order no longer expired
     96 .. S ORREP=$P(^OR(100,IFN,3),U,6)
     97 .. Q:+$G(ORREP)>0  ;quit if order has been replaced
     98 .. S ^TMP("ORSORT",$J,9999999-TM,TO,IFN)=""
     99 S TM=0 F  S TM=$O(^TMP("ORSORT",$J,TM)) Q:'TM  S TO=0 F  S TO=$O(^TMP("ORSORT",$J,TM,TO)) Q:'TO  D
     100 . S IFN=0 F  S IFN=$O(^TMP("ORSORT",$J,TM,TO,IFN)) Q:'IFN  I $D(^OR(100,IFN,0)),$D(^(3)) S X0=^(0),X3=^(3) D
     101 .. S ACTOR=0 F  S ACTOR=$O(^OR(100,"ACT",PAT,9999999-$P(X0,U,7),TO,IFN,ACTOR)) Q:ACTOR<1  I '$D(^TMP("ORGOTIT",$J,IFN,ACTOR)),$D(^OR(100,IFN,8,ACTOR,0)),$P(^(0),U,15)'=13 S X8=^(0),X7=$G(^(7)) D LP1^ORQ11
     102 S ^TMP("ORR",$J,ORLIST,"TOT")=ORLST
     103 K ^TMP("ORSORT",$J),^TMP("ORGOTIT",$J)
     104 Q
     105GETEIE(IFN,NEWD,DETAIL,ACTOR) ; -- Setup TMP array
     106 ; IFN=ifn of order
     107 ; NEWD=3rd subscript in ^TMP("ORR",$J, node (ORLIST)
     108 ; DETAIL=see description in ^ORQ1
     109 ;
     110 N X0,X3,X4,X6,TXT,STAT,START,DG,STOP,ENTERD,DCREAS
     111 S X0=^OR(100,IFN,0),X3=$G(^(3)),X4=$G(^(4)),X6=$G(^(6))
     112 S DG=$P(X0,U,11),DG=$P($G(^ORD(100.98,+DG,0)),U,3)
     113 S STAT=$S($P(X3,U,3):$P(^ORD(100.01,$P(X3,U,3),0),U,1,2),1:"")
     114 S ENTERD=$P(X0,U,7),START=$P(X0,U,8),STOP=$P(X0,U,9)
     115 S DCREAS=$P($G(X6),U,4) Q:DCREAS'>0
     116 I DCREAS'=$O(^ORD(100.03,"B","Entered in error","")) Q
     117 S ORLST=ORLST+1,^TMP("ORGOTIT",$J,IFN,+$G(ACTOR))=""
     118 I '$G(DETAIL) S ^TMP("ORR",$J,NEWD,ORLST)=IFN_$S($G(ACTOR):";"_ACTOR,1:"") Q
     119 S ^TMP("ORR",$J,NEWD,ORLST)=IFN_$S($G(ACTOR):";"_ACTOR,1:"")_U_DG_U_ENTERD_U_START_U_STOP_U_STAT
     120 D TEXT(.TXT,IFN) M ^TMP("ORR",$J,NEWD,ORLST,"TX")=TXT
     121 Q
Note: See TracChangeset for help on using the changeset viewer.