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

    r613 r623  
    1 ORCDPS3 ;SLC/MKB-Pharmacy dialog utilities ;09/11/07
    2         ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,134,158,149,190,277,243**;Dec 17, 1997;Build 242
    3         ;
    4 START   ; -- Start Date entry action
    5         S $P(ORDIALOG(PROMPT,0),":",3)=$S($G(ORCAT)="I":"ETRX",1:"EX")
    6         I $G(ORCAT)'="I" K ORSD K:$G(ORENEW)!$G(OREWRITE)!$D(OREDIT) ORDIALOG(PROMPT,INST) ;Inpt only
    7         Q
    8         ;
    9 ADMIN   ; -- Return default admin time for order in ORSD
    10         ;    Called from EXDOSE^ORCDPS2
    11         Q:$D(ORSD)  Q:$G(ORCAT)'="I"  ;inpt only
    12         N PSOI,PSIFN,SCH,CNJ,ORI,ORX
    13         S PSOI=+$P($G(^ORD(101.43,+$G(OROI),0)),U,2)
    14         S PSIFN=$S($G(ORENEW):$G(^OR(100,+$G(ORIFN),4)),1:"")
    15         S SCH=$$PTR^ORCD("OR GTX SCHEDULE"),CNJ=$$PTR^ORCD("OR GTX AND/THEN"),ORX=""
    16         S ORI=0 F  S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI<1  S ORX=ORX_$S($L(ORX):U,1:"")_$G(ORDIALOG(CNJ,ORI))_";"_$G(ORDIALOG(SCH,ORI))
    17         S ORSD=$$FIRST(+ORVP,+$G(ORWARD),PSOI,ORX,PSIFN,"")
    18         S:$P(ORSD,U)="NEXT" ORSD="NEXTA^"_$P(ORSD,U,2,99)
    19         Q
    20         ;
    21 FIRST(DFN,WARD,OI,DATA,ORDER,ADMIN)       ; -- Return expected first admin time of order
    22         N CNT,ORCNT,ORI,J,ORZ,Y,SCH,ORX,TNUM
    23         I '$G(DFN)!'$G(OI) Q ""
    24         S ORCNT=0 F ORI=1:1:$L(DATA,"^") S ORZ=$P(DATA,U,ORI) D  Q:$E(ORZ)="T"
    25         .S TNUM=$$NUMCHAR(ORZ,";") Q:TNUM=0
    26         .F CNT=1:1:TNUM D
    27         .. S SCH=$P(ORZ,";",CNT+1) Q:'$L(SCH)  S ORCNT=ORCNT+1
    28         .. I ORCNT>1 S ADMIN=""
    29         .. S ORX(ORCNT)=$$STARTSTP^PSJORPOE(DFN,SCH,OI,WARD,$G(ORDER),$G(ADMIN))
    30         S Y=9999999,J=0
    31         F ORI=1:1:ORCNT S ORZ=$P(ORX(ORI),U,4) I ORZ<Y S Y=ORZ,J=ORI ;earliest
    32         S Y=$S(J:ORX(J),1:"")
    33         Q Y
    34         ;
    35 NUMCHAR(STRING,SUB)     ;
    36         N CNT,RESULT
    37         S RESULT=0
    38         F CNT=1:1:$L(STRING) I $E(STRING,CNT)=SUB S RESULT=RESULT+1
    39         Q RESULT
    40         ;
    41 NOW     ; -- First dose now?
    42         N X,Y,DIR,SCH
    43         K ^TMP($J,"ORCDPS3 NOW")
    44         I $G(ORCAT)="O"!'$D(ORSD)!$L($G(OREVENT))!$G(ORENEW) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
    45         D AP^PSS51P1("PSJ",,,,"ORCDPS3 NOW")
    46         ; ask on Copy? Change?
    47         S X=$$PTR^ORCD("OR GTX SCHEDULE"),Y=+$O(ORDIALOG(X,0))
    48         S SCH=$G(ORDIALOG(X,Y)),Y=+$O(^TMP($J,"ORCDPS3 NOW","APPSJ",SCH,0)) ;1st one
    49         ;S SCH=$G(ORDIALOG(X,Y)),Y=+$O(^PS(51.1,"APPSJ",SCH,0)) ;1st one
    50         I $G(^TMP($J,"ORCDPS3 NOW",SCH,5))=""!(Y<1) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
    51         ;I $P($G(^PS(51.1,Y,0)),U,5)="O"!(Y<1) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
    52         ; other conditions?
    53         S DIR(0)="YA",DIR("A")="Give additional dose NOW? "
    54         S DIR("B")=$S($G(ORDIALOG(PROMPT,INST)):"YES",1:"NO")
    55         I ORINPT,$P(ORSD,U,4) S DIR("A",1)="Next scheduled administration time: "_$$FMTE^XLFDT($P(ORSD,U,4))
    56         S DIR("?")="Enter YES if you want a dose given now in addition to the regular administration times for this schedule and ward."
    57         D ^DIR S:$D(DTOUT)!$D(DUOUT) ORQUIT=1
    58         I $G(ORQUIT)!(Y'>0) K ORDIALOG(PROMPT,INST),^TMP($J,"ORCDPS3 NOW") Q
    59         S ORDIALOG(PROMPT,INST)=1 I $G(ORCOMPLX) D
    60         . W $C(7),!,"  >> First Dose NOW is in addition to those already entered.    <<"
    61         . W !,"  >> Please adjust the duration of the first one, if necessary. <<"
    62         K ^TMP($J,"ORCDPS3 NOW")
    63         Q
    64         ;
    65 DEFSTRT ; -- Returns default start date/time in Y
    66         ;    Expects PROMPT,INST,ORDIALOG,ORSD to be defined
    67         ;
    68         Q:$G(ORCAT)="O"  Q:$G(ORTYPE)="Z"  ;skip if outpt or editor
    69         N LAST,STRT,DUR,D1,D2,OFF,F1,F2,UNT,Y1,Y2,I,J K Y
    70         S LAST=+$O(ORDIALOG(+$$PTR^ORCD("OR GTX INSTRUCTIONS"),INST),-1)
    71         S STRT=$G(ORDIALOG(PROMPT,LAST))
    72         I LAST'>0!'$L(STRT) S:$L($P($G(ORSD),U)) Y=$P(ORSD,U) Q  ;first inst
    73         S DUR=$G(ORDIALOG(+$$PTR^ORCD("OR GTX DURATION"),LAST))
    74         I +DUR'>0 S Y=STRT Q  ;no duration = same start
    75         S DUR=$$FMDUR(DUR) I STRT D  Q  ;FM date/time, so just add
    76         . N X,%DT S %DT="TX",X=STRT_"+"_DUR D ^%DT
    77         . I Y'>0 S Y=STRT ;error
    78         S D1=+DUR,D2=$P(DUR,D1,2) S:(STRT="NEXTA")!(STRT="CLOSEST") STRT="NOW"
    79         S OFF=$P(STRT,"+",2) I '$L(OFF) S Y=STRT_"+"_DUR Q  ;no prev offset
    80         S F1=+OFF,F2=$P(OFF,F1,2),UNT=F2,Y=STRT
    81         I D2=F2 S Y=$P(STRT,"+")_"+"_(D1+F1)_UNT Q  ;same units
    82         F I="S","'","H","D","W","M" I (F2=I)!(D2=I) S UNT=I D  Q
    83         . S:D2=UNT Y1=D1,X1=F1,X2=F2 ; Y1=# in UNT
    84         . S:F2=UNT Y1=F1,X1=D1,X2=D2 ; X1=# in other units X2
    85         . F J=1:1 S Z=$T(CONV+J) Q:Z["ZZZZ"  I $P(Z,";",3,4)=(X2_";"_UNT) S Y2=+$P(Z,";",5) Q
    86         . S Y=$P(STRT,"+")_"+"_(Y1+$S(Y2:Y2*X1,1:0))_UNT
    87         Q
    88         ;
    89 FMDUR(X)               ; -- convert '# DAYS' to #D
    90         N X1,X2,Y I +X'>0 Q ""
    91         S X1=+X,X2=$P(X," ",2) S:'$L(X2) X2="DAYS"
    92         S Y=X1_$S("MINUTES"[X2:"'",1:$E(X2))
    93         Q Y
    94         ;
    95 CONV    ;;unit;unit;factor
    96         ;;';S;60
    97         ;;H;';60
    98         ;;H;S;3600
    99         ;;D;H;24
    100         ;;D;';1440
    101         ;;D;S;86400
    102         ;;W;D;7
    103         ;;W;H;168
    104         ;;W;';10080
    105         ;;W;S;604800
    106         ;;M;W;4
    107         ;;M;D;30
    108         ;;M;H;720
    109         ;;M;';43200
    110         ;;M;S;2592000
    111         ;;ZZZZ
    112         ;
    113 ASKDUR()               ; -- Returns 1 or 0, if Duration prompt should be asked
    114         K ^TMP($J,"ORCDPS3 ASKDUR")
    115         N X,Y I '$G(ORCOMPLX) K ORDIALOG(PROMPT,INST) Q 0
    116         S Y=1 G:'$L($G(ORSCH)) ADQ ;no schedule
    117         D AP^PSS51P1("PSJ",,,,"ORCDPS3 ASKDUR")
    118         S X=+$O(^TMP($J,"ORCDPS3 ASKDUR","APPSJ",ORSCH,"")) G:X'>0 ADQ
    119         ;S X=+$O(^PS(51.1,"APPSJ",ORSCH,0)) G:X'>0 ADQ
    120         S:^TMP($J,"ORCDPS3 ASKDUR",X,5)="O" Y=0
    121         ;S:$P($G(^PS(51.1,X,0)),U,5)="O" Y=0
    122 ADQ     ;
    123         K ^TMP($J,"ORCDPS3 ASKDUR")
    124         Q Y
    125         ;
    126 CKDUR(X)        ; -- Returns validated form of duration X, or null if invalid
    127         N X1,X2,Y,Z S Y=""
    128         S X1=+$G(X),X2=$P($G(X),X1,2) I X1'>0 Q ""
    129         S X2=$$UP^XLFSTR(X2),X2=$$STRIP^XLFSTR(X2," ") S:'$L(X2) X2="DAYS"
    130         F Z="MONTHS^&MONTHS&MONS","WEEKS^&WEEKS&WKS","DAYS^&DAYS&DYS","HOURS^&HOURS&HRS","MINUTES^&MINUTES&MINS'","SECONDS^&SECONDS&SECS" I $P(Z,U,2)[("&"_X2) S Y=$P(Z,U) Q
    131         S:$L(Y) Y=X1_" "_$S(X1=1:$E(Y,1,$L(Y)-1),1:Y) ;strip trailing 's'
    132         Q Y
    133         ;
    134 DUR     ; -- Process duration [from P-S Action]
    135         N X S X=$G(ORDIALOG(PROMPT,ORI)),X=$$CKDUR(X)
    136         I '$L(X) K DONE W $C(7),!,ORDIALOG(PROMPT,"?"),! Q
    137         S ORDIALOG(PROMPT,ORI)=X D:$G(ORESET)'=X CHANGED^ORCDPS1("QUANTITY")
    138         Q
    139         ;
    140 TEST(START,DURTN)             ; -- test DEFSTRT
    141         N INST,ORSD,ORDIALOG,PROMPT
    142         S ORDIALOG(136,1)="",INST=2,ORSD="NOW",PROMPT=6
    143         S:$L($G(START)) ORDIALOG(6,1)=START S:$G(DURTN) ORDIALOG(153,1)=DURTN
    144         D DEFSTRT W !,Y
    145         Q
    146         ;
    147 SC      ; -- Dialog validation, to ask SC questions
    148         ;    Expects ORIFN, ORDA, and ORDER
    149         ;
    150         Q:'$L($T(SCNEW^PSOCP))  Q:'$G(ORIFN)  Q:'$G(ORDA)
    151         Q:$P($G(^OR(100,ORIFN,0)),U,12)'="O"  Q:$P($G(^(8,ORDA,0)),U,2)'="NW"  Q:$P($G(^(0)),U,15)=""
    152         ;
    153         N OR3,ORDRUG,PSIFN,ORX,I,J,DIE,DR,DA,X,Y,DTOUT,ORIGVIEW,DFN
    154         S OR3=$G(^OR(100,ORIFN,3)),X=$P(OR3,U,11) I X>2 Q  ;new, edit, or renew
    155         I X S Y=$P(OR3,U,5),PSIFN=$G(^OR(100,Y,4)) ;get PS# if edit/renewal
    156         S ORDRUG=$$VALUE^ORCSAVE2(ORIFN,"DRUG")
    157         D SCNEW^PSOCP(.ORX,+ORVP,ORDRUG,$G(PSIFN)) Q:'$D(ORX)
    158         S DIE="^OR(100,",DA=ORIFN,DR="",J=0
    159         F I="SC","MST","AO","IR","EC","HNC","CV" S J=J+1 I $D(ORX(I)) S X=ORX(I) S:I="CV"&(X="") X=1 S DR=DR_";5"_J_"R"_$S($L(X):"//"_$S(X:"YES",1:"NO"),1:"")
    160         S:$E(DR)=";" DR=$E(DR,2,999) Q:'$L(DR)  S ORIGVIEW=1
    161         I $D(ORX("SC")) S DFN=+ORVP D DIS^DGRPDB ;show current SC data
    162         W !!,"Is "_$$ORDITEM^ORCACT(ORDER)_" for treatment related to:"
    163         D ^DIE S:$D(DTOUT)!$D(Y) ORQUIT=1
    164         Q
     1ORCDPS3 ;SLC/MKB-Pharmacy dialog utilities ;11/25/02  09:47
     2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,134,158,149,190,277**;Dec 17, 199;Build 13
     3 ;
     4START ; -- Start Date entry action
     5 S $P(ORDIALOG(PROMPT,0),":",3)=$S($G(ORCAT)="I":"ETRX",1:"EX")
     6 I $G(ORCAT)'="I" K ORSD K:$G(ORENEW)!$G(OREWRITE)!$D(OREDIT) ORDIALOG(PROMPT,INST) ;Inpt only
     7 Q
     8 ;
     9ADMIN ; -- Return default admin time for order in ORSD
     10 ;    Called from EXDOSE^ORCDPS2
     11 Q:$D(ORSD)  Q:$G(ORCAT)'="I"  ;inpt only
     12 N PSOI,PSIFN,SCH,CNJ,ORI,ORX
     13 S PSOI=+$P($G(^ORD(101.43,+$G(OROI),0)),U,2)
     14 S PSIFN=$S($G(ORENEW):$G(^OR(100,+$G(ORIFN),4)),1:"")
     15 S SCH=$$PTR^ORCD("OR GTX SCHEDULE"),CNJ=$$PTR^ORCD("OR GTX AND/THEN"),ORX=""
     16 S ORI=0 F  S ORI=$O(ORDIALOG(PROMPT,ORI)) Q:ORI<1  S ORX=ORX_$S($L(ORX):U,1:"")_$G(ORDIALOG(CNJ,ORI))_";"_$G(ORDIALOG(SCH,ORI))
     17 S ORSD=$$FIRST(+ORVP,+$G(ORWARD),PSOI,ORX,PSIFN)
     18 S:$P(ORSD,U)="NEXT" ORSD="NEXTA^"_$P(ORSD,U,2,99)
     19 Q
     20 ;
     21FIRST(DFN,WARD,OI,DATA,ORDER) ; -- Return expected first admin time of order
     22 N ORCNT,ORI,J,ORZ,Y,SCH,ORX I '$G(DFN)!'$G(OI) Q ""
     23 S ORCNT=0 F ORI=1:1:$L(DATA,"^") S ORZ=$P(DATA,U,ORI) D  Q:$E(ORZ)="T"
     24 . S SCH=$P(ORZ,";",2) Q:'$L(SCH)  S ORCNT=ORCNT+1
     25 . S ORX(ORCNT)=$$STARTSTP^PSJORPOE(DFN,SCH,OI,WARD,$G(ORDER))
     26 S Y=9999999,J=0
     27 F ORI=1:1:ORCNT S ORZ=$P(ORX(ORI),U,4) I ORZ<Y S Y=ORZ,J=ORI ;earliest
     28 S Y=$S(J:ORX(J),1:"")
     29 Q Y
     30 ;
     31NOW ; -- First dose now?
     32 N X,Y,DIR,SCH
     33 I $G(ORCAT)="O"!'$D(ORSD)!$L($G(OREVENT))!$G(ORENEW) K ORDIALOG(PROMPT,INST) Q
     34 ; ask on Copy? Change?
     35 S X=$$PTR^ORCD("OR GTX SCHEDULE"),Y=+$O(ORDIALOG(X,0))
     36 S SCH=$G(ORDIALOG(X,Y)),Y=+$O(^PS(51.1,"APPSJ",SCH,0)) ;1st one
     37 I $P($G(^PS(51.1,Y,0)),U,5)="O"!(Y<1) K ORDIALOG(PROMPT,INST) Q
     38 ; other conditions?
     39 S DIR(0)="YA",DIR("A")="Give additional dose NOW? "
     40 S DIR("B")=$S($G(ORDIALOG(PROMPT,INST)):"YES",1:"NO")
     41 I ORINPT,$P(ORSD,U,4) S DIR("A",1)="Next scheduled administration time: "_$$FMTE^XLFDT($P(ORSD,U,4))
     42 S DIR("?")="Enter YES if you want a dose given now in addition to the regular administration times for this schedule and ward."
     43 D ^DIR S:$D(DTOUT)!$D(DUOUT) ORQUIT=1
     44 I $G(ORQUIT)!(Y'>0) K ORDIALOG(PROMPT,INST) Q
     45 S ORDIALOG(PROMPT,INST)=1 I $G(ORCOMPLX) D
     46 . W $C(7),!,"  >> First Dose NOW is in addition to those already entered.    <<"
     47 . W !,"  >> Please adjust the duration of the first one, if necessary. <<"
     48 Q
     49 ;
     50DEFSTRT ; -- Returns default start date/time in Y
     51 ;    Expects PROMPT,INST,ORDIALOG,ORSD to be defined
     52 ;
     53 Q:$G(ORCAT)="O"  Q:$G(ORTYPE)="Z"  ;skip if outpt or editor
     54 N LAST,STRT,DUR,D1,D2,OFF,F1,F2,UNT,Y1,Y2,I,J K Y
     55 S LAST=+$O(ORDIALOG(+$$PTR^ORCD("OR GTX INSTRUCTIONS"),INST),-1)
     56 S STRT=$G(ORDIALOG(PROMPT,LAST))
     57 I LAST'>0!'$L(STRT) S:$L($P($G(ORSD),U)) Y=$P(ORSD,U) Q  ;first inst
     58 S DUR=$G(ORDIALOG(+$$PTR^ORCD("OR GTX DURATION"),LAST))
     59 I +DUR'>0 S Y=STRT Q  ;no duration = same start
     60 S DUR=$$FMDUR(DUR) I STRT D  Q  ;FM date/time, so just add
     61 . N X,%DT S %DT="TX",X=STRT_"+"_DUR D ^%DT
     62 . I Y'>0 S Y=STRT ;error
     63 S D1=+DUR,D2=$P(DUR,D1,2) S:(STRT="NEXTA")!(STRT="CLOSEST") STRT="NOW"
     64 S OFF=$P(STRT,"+",2) I '$L(OFF) S Y=STRT_"+"_DUR Q  ;no prev offset
     65 S F1=+OFF,F2=$P(OFF,F1,2),UNT=F2,Y=STRT
     66 I D2=F2 S Y=$P(STRT,"+")_"+"_(D1+F1)_UNT Q  ;same units
     67 F I="S","'","H","D","W","M" I (F2=I)!(D2=I) S UNT=I D  Q
     68 . S:D2=UNT Y1=D1,X1=F1,X2=F2 ; Y1=# in UNT
     69 . S:F2=UNT Y1=F1,X1=D1,X2=D2 ; X1=# in other units X2
     70 . F J=1:1 S Z=$T(CONV+J) Q:Z["ZZZZ"  I $P(Z,";",3,4)=(X2_";"_UNT) S Y2=+$P(Z,";",5) Q
     71 . S Y=$P(STRT,"+")_"+"_(Y1+$S(Y2:Y2*X1,1:0))_UNT
     72 Q
     73 ;
     74FMDUR(X) ; -- convert '# DAYS' to #D
     75 N X1,X2,Y I +X'>0 Q ""
     76 S X1=+X,X2=$P(X," ",2) S:'$L(X2) X2="DAYS"
     77 S Y=X1_$S("MINUTES"[X2:"'",1:$E(X2))
     78 Q Y
     79 ;
     80CONV ;;unit;unit;factor
     81 ;;';S;60
     82 ;;H;';60
     83 ;;H;S;3600
     84 ;;D;H;24
     85 ;;D;';1440
     86 ;;D;S;86400
     87 ;;W;D;7
     88 ;;W;H;168
     89 ;;W;';10080
     90 ;;W;S;604800
     91 ;;M;W;4
     92 ;;M;D;30
     93 ;;M;H;720
     94 ;;M;';43200
     95 ;;M;S;2592000
     96 ;;ZZZZ
     97 ;
     98ASKDUR() ; -- Returns 1 or 0, if Duration prompt should be asked
     99 N X,Y I '$G(ORCOMPLX) K ORDIALOG(PROMPT,INST) Q 0
     100 S Y=1 G:'$L($G(ORSCH)) ADQ ;no schedule
     101 S X=+$O(^PS(51.1,"APPSJ",ORSCH,0)) G:X'>0 ADQ
     102 S:$P($G(^PS(51.1,X,0)),U,5)="O" Y=0
     103ADQ Q Y
     104 ;
     105CKDUR(X) ; -- Returns validated form of duration X, or null if invalid
     106 N X1,X2,Y,Z S Y=""
     107 S X1=+$G(X),X2=$P($G(X),X1,2) I X1'>0 Q ""
     108 S X2=$$UP^XLFSTR(X2),X2=$$STRIP^XLFSTR(X2," ") S:'$L(X2) X2="DAYS"
     109 F Z="MONTHS^&MONTHS&MONS","WEEKS^&WEEKS&WKS","DAYS^&DAYS&DYS","HOURS^&HOURS&HRS","MINUTES^&MINUTES&MINS'","SECONDS^&SECONDS&SECS" I $P(Z,U,2)[("&"_X2) S Y=$P(Z,U) Q
     110 S:$L(Y) Y=X1_" "_$S(X1=1:$E(Y,1,$L(Y)-1),1:Y) ;strip trailing 's'
     111 Q Y
     112 ;
     113DUR ; -- Process duration [from P-S Action]
     114 N X S X=$G(ORDIALOG(PROMPT,ORI)),X=$$CKDUR(X)
     115 I '$L(X) K DONE W $C(7),!,ORDIALOG(PROMPT,"?"),! Q
     116 S ORDIALOG(PROMPT,ORI)=X D:$G(ORESET)'=X CHANGED^ORCDPS1("QUANTITY")
     117 Q
     118 ;
     119TEST(START,DURTN) ; -- test DEFSTRT
     120 N INST,ORSD,ORDIALOG,PROMPT
     121 S ORDIALOG(136,1)="",INST=2,ORSD="NOW",PROMPT=6
     122 S:$L($G(START)) ORDIALOG(6,1)=START S:$G(DURTN) ORDIALOG(153,1)=DURTN
     123 D DEFSTRT W !,Y
     124 Q
     125 ;
     126SC ; -- Dialog validation, to ask SC questions
     127 ;    Expects ORIFN, ORDA, and ORDER
     128 ;
     129 Q:'$L($T(SCNEW^PSOCP))  Q:'$G(ORIFN)  Q:'$G(ORDA)
     130 Q:$P($G(^OR(100,ORIFN,0)),U,12)'="O"  Q:$P($G(^(8,ORDA,0)),U,2)'="NW"  Q:$P($G(^(0)),U,15)=""
     131 ;
     132 N OR3,ORDRUG,PSIFN,ORX,I,J,DIE,DR,DA,X,Y,DTOUT,ORIGVIEW,DFN
     133 S OR3=$G(^OR(100,ORIFN,3)),X=$P(OR3,U,11) I X>2 Q  ;new, edit, or renew
     134 I X S Y=$P(OR3,U,5),PSIFN=$G(^OR(100,Y,4)) ;get PS# if edit/renewal
     135 S ORDRUG=$$VALUE^ORCSAVE2(ORIFN,"DRUG")
     136 D SCNEW^PSOCP(.ORX,+ORVP,ORDRUG,$G(PSIFN)) Q:'$D(ORX)
     137 S DIE="^OR(100,",DA=ORIFN,DR="",J=0
     138 F I="SC","MST","AO","IR","EC","HNC","CV" S J=J+1 I $D(ORX(I)) S X=ORX(I) S:I="CV"&(X="") X=1 S DR=DR_";5"_J_"R"_$S($L(X):"//"_$S(X:"YES",1:"NO"),1:"")
     139 S:$E(DR)=";" DR=$E(DR,2,999) Q:'$L(DR)  S ORIGVIEW=1
     140 I $D(ORX("SC")) S DFN=+ORVP D DIS^DGRPDB ;show current SC data
     141 W !!,"Is "_$$ORDITEM^ORCACT(ORDER)_" for treatment related to:"
     142 D ^DIE S:$D(DTOUT)!$D(Y) ORQUIT=1
     143 Q
Note: See TracChangeset for help on using the changeset viewer.