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/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOOREDT.m

    r613 r623  
    1 PSOOREDT        ;BIR/SAB - edit orders from backdoor ;11:19 AM  1 Jan 2009
    2         ;;7.0;OUTPATIENT PHARMACY;**4,20,27,37,57,46,78,102,104,119,143,148,260,281,208**;DEC 1997;Build 41;WorldVistA 30-Jan-08
    3         ;
    4         ;Modified from FOIA VISTA,
    5         ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    6         ;General Public License See attached copy of the License.
    7         ;
    8         ;This program is free software; you can redistribute it and/or modify
    9         ;it under the terms of the GNU General Public License as published by
    10         ;the Free Software Foundation; either version 2 of the License, or
    11         ;(at your option) any later version.
    12         ;
    13         ;This program is distributed in the hope that it will be useful,
    14         ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    15         ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    16         ;GNU General Public License for more details.
    17         ;
    18         ;You should have received a copy of the GNU General Public License along
    19         ;with this program; if not, write to the Free Software Foundation, Inc.,
    20         ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    21         ;
    22         ;External reference to ^PSDRUG supported by DBIA 221
    23         ;External reference to PSSLOCK supported by DBIA 2789
    24         ;External reference to ^VA(200 supported by DBIA 10060
    25 SEL     K PSOISLKD,PSOLOKED S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY D SVAL K PSOPLCK S VALMBCK="" Q
    26         K PSOPLCK D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) D UL^PSSLOCK(+$G(PSODFN)) D SVALO K PSOMSG S VALMBCK="" Q
    27         K PSOMSG S PSOLOKED=1
    28         K PSORX("DFLG"),DIR,DUOUT,DIRUT S DIR("A")="Select fields by number"
    29         S DIR(0)="LO^1:"_$S($$STATUS^PSOBPSUT($P(PSOLST(ORN),"^",2))'="":21,$G(REF):20,1:19)
    30         D ^DIR I $D(DIRUT) K DIR,DIRUT,DTOUT S VALMBCK="" D UL K PSOLOKED Q
    31 EDTSEL  N VALMCNT K PSOISLKD,PSORX("DFLG"),PSOOIFLG,PSOMRFLG,DIR,DIRUT,DTOUT,DTOUT,ZONE S (PSOEDIT,PSORXED)=1 I +Y S FST=Y D HLDHDR^PSOLMUTL D  G EX ;PSO LM SELECT MENU protocol
    32         .I '$G(PSOLOKED) S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY D SVAL K PSOPLCK S VALMBCK="",(PSOISLKD,PSODE)=1 Q
    33         .I '$G(PSOLOKED) K PSOPLCK D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) D UL^PSSLOCK(+$G(PSODFN)) D SVALO K PSOMSG S VALMBCK="",(PSOISLKD,PSODE)=1 Q
    34         .K PSOMSG,PSOPLCK S (NEWEDT,PSOLOKED)=1 D EDT
    35         E  S VALMBCK="",PSODE=1
    36 EX      I $G(PSOISLKD) D UL K PSOISLKD G EX2
    37         I '$G(PSOSIGFL),'$G(PSORXED("DFLG")) D UPDATE^PSOORED6 D LOG^PSORXED,POST^PSORXED G EX1
    38         I $G(PSOSIGFL)=1 D  Q:$G(PSORX("FN"))
    39         .N PSOTMP
    40         .S PSOTMP=$G(PSOFROM),PSOFROM="NEW"
    41         .S VALMSG="This change will create a new prescription!",NCPDPFLG=1
    42         .D EN^PSOORED1(.PSORXED)
    43         .I $G(PSORX("FN")) D  Q
    44         ..D ^PSOBUILD
    45         ..K QUIT,PSORX("DFLG"),FST,FLD,IEN,FLN,INCOM,PSOI,PSODRUG,PSOEDIT
    46         ..K PSORENW,PSOSIGFL,PSOOIFLG,PSOMRFLG,PSODIR,CHK,PSORX("SIG"),PSODE
    47         ..K PSOTRN,PSORX("EDIT"),PSORXED("FLD"),NEWEDT
    48         ..D EOJ^PSONEW
    49         ..D UL K PSOLOKED S VALMBCK="Q"
    50         .S PSOFROM=PSOTMP I PSOFROM="" K PSOFROM
    51         ;
    52 EX1     I '$G(PSODE)!('$G(ZONE)) I $G(PSORENW("OIRXN")) D EN^PSOHLSN1(PSORENW("OIRXN"),"XX","","Order edited")
    53 QUIT    D UL K PSOLOKED D ^PSOBUILD,ACT^PSOORNE2 D:+^PSRX($P(PSOLST(ORN),"^",2),"STA")=5 EN^PSOCMOPC($P(PSOLST(ORN),"^",2))
    54         K:'$O(^PSRX($P(PSOLST(ORN),"^",2),1,0)) REF
    55 EX2     S VALMBCK=$S($G(PSORX("FN")):"Q",$G(ZONE):"Q",1:"R") K PSORXED,FST,FLD,IEN,FLN,INCOM,PSOI,PSODRUG,PSOEDIT,PSORENW,PSOSIGFL,PSODIR,CHK,PSORX("SIG"),PSODE,PSOTRN,PSORX("DFLG"),RFED,ZONE,PSORX("EDIT"),PSOOIFLG,PSOMRFLG,SIG,QUIT
    56         K NEWEDT I $G(VALMBCK)="R" W ! D CLEAN^PSOVER1 H 2
    57         Q
    58         ;
    59 EDT     ; Rx Edit (Backdoor)
    60         K NCPDPFLG
    61         S I=0 F  S I=$O(^PSRX($P(PSOLST(ORN),"^",2),1,I)) Q:'I  S PSORXED("RX1")=^PSRX($P(PSOLST(ORN),"^",2),1,I,0)
    62         S (RX0,PSORXED("RX0"))=^PSRX($P(PSOLST(ORN),"^",2),0),PSORXED("RX2")=$G(^(2)),PSORXED("RX3")=$G(^(3)),PSOSIG=$P(^("SIG"),"^")
    63         F FLD=1:1:$L(FST,",") Q:$P(FST,",",FLD)']""!($G(PSORXED("DFLG")))!($G(PSORX("DFLG")))  S FLN=+$P(FST,",",FLD) D
    64         .S PSORXED("DFLG")=0,(DA,PSORXED("IRXN"),PSORENW("OIRXN"))=$P(PSOLST(ORN),"^",2),RX0=^PSRX(PSORXED("IRXN"),0) S:$G(PSOSIG)="" PSOSIG=$P(^("SIG"),"^")
    65         .I '$G(PSOSIGFL) D
    66         ..S PSOI=+^PSRX(DA,"OR1"),PSODAYS=$P(RX0,"^",8),PSORXST=+$P($G(^PS(53,$P(RX0,"^",3),0)),"^",7)
    67         ..I 'PSOI S PSOI=+^PSDRUG($P(RX0,"^",6),2),$P(^PSRX(DA,"OR1"),"^")=PSOI
    68         ..S:'$G(PSODRUG("IEN")) PSODRUG("IEN")=$P(RX0,"^",6),PSODRUG("NAME")=$P(^PSDRUG($P(RX0,"^",6),0),"^")
    69         ..S PSODRUG("OI")=PSOI
    70         .S PSORX("PROVIDER")=$P(RX0,"^",4),PSORX("PROVIDER NAME")=$P(^VA(200,$P(RX0,"^",4),0),"^"),PSOTRN=$G(^PSRX(DA,"TN"))
    71         .D:'$G(CHK) POP^PSOSIGNO(DA),CHK Q:$G(PSORXED("DFLG"))
    72         .S FDR="39.2^"_$S($P(PSOPAR,"^",3):"6",1:"")_";6.5^113^114^3^1^22R^24^8^7^9^4^11;"_$S($P(RX0,"^",11)="W"&($P(PSOPAR,"^",12)):"35;",1:"")_"^10.6^5^20^23^12^PSOCOU^RF^81"
    73         .I $G(ST)=11!($G(ST)=12) D NDCDAWDE^PSOORED7(ST,FLN,$G(RXN)) Q
    74         .I FLN=20,'$G(REF) S VALMSG="There is no Refill Data to be edited." Q
    75         .S DR=$P(FDR,"^",FLN) I DR="RF" D REF^PSOORED2 Q
    76         .I DR="PSOCOU" D PSOCOU^PSOORED6 Q
    77         .I FLN=2,'$P(PSOPAR,"^",3),$$RXRLDT^PSOBPSUT(RXN,0),$$STATUS^PSOBPSUT(RXN,0)'="" D  Q
    78         ..N NDC D NDC^PSODRG(RXN,0,,.NDC) I $G(NDC)="^"!($G(NDC)="") Q
    79         ..S (PSODRUG("NDC"),PSORXED("FLD",27))=NDC
    80         .I FLN'>2,'$P(PSOPAR,"^",3) S VALMSG="Check site parameters, Drug data is not editable." Q
    81         .I FLN=3 D EDTDOSE^PSOORED2 Q
    82         .I FLN=4 D INS^PSOORED1 Q
    83         .I FLN=1 D PSOI^PSOORED6 N PSOX S PSORXED=1,PSOX("IRXN")=$S($D(DA):DA,$D(PSORXED("IRXN")):PSORXED("IRXN"),$D(PSORENW("OIRXN")):PSORENW("OIRXN")) D:'$G(PSORXED("DFLG")) EN^PSODIAG Q
    84         .I FLN=2 D DRG^PSOORED6 N PSOX S PSORXED=1,PSOX("IRXN")=PSORXED("IRXN") D:'$G(PSORXED("DFLG")) EN^PSODIAG S:$O(^PSRX(PSORXED("IRXN"),1,0)) REF=1 Q
    85         .I FLN=12 D PROV Q
    86         .I FLN=6 D ISDT^PSOORED2 Q
    87         .I FLN=7 D FLDT^PSOORED2 Q
    88         .I FLN=21,$$STATUS^PSOBPSUT(RXN,0)="" S VALMSG="Invalid selection!" Q
    89         .I FLN=21 D  Q
    90         ..N DAW D EDTDAW^PSODAWUT(RXN,0,.DAW) I $G(DAW)="^" Q
    91         ..S (PSODRUG("DAW"),PSORXED("FLD",81))=DAW
    92         .I FLN=9!(FLN=10)!(FLN=11) D NOCHG^PSOORED7 Q
    93         .S DR=+DR
    94         .K DIR,DIRUT,DIROUT ;S DIE=52 D ^DIE I $D(Y) S PSORXED("DFLG")=1
    95         .K DIC,DIQ S DIC=52,DA=PSORXED("IRXN"),DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ
    96         .S DIR("B")=$S($G(PSORXED("FLD",DR))]"":PSORXED("FLD",DR),1:PSORXED(52,DA,DR)),DIR(0)="52,"_DR D ^DIR
    97         .I DR=24!(DR=12) S PSORXED("FLD",DR)=X
    98         .I $D(DIRUT) K DIR,DIRUT,DUOUT,DTOUT,PSORXED(52,DA,DR),PSORXED("FLD",DR) Q
    99         .I DR'=5,X="@" W !,"Data Required!",! K DIC,DIQ,DR,DA,DIR,DIRUT,PSORXED(52,DA,DR),X,Y Q
    100         .I DR=5,X'="@" S Y=+Y
    101         .I DR=3!(DR=20)!(DR=23) S Y=+Y
    102         .S PSORXED("FLD",DR)=$S(X="@":X,1:Y) K DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)
    103         .I DR=11,PSORXED("FLD",DR)="W",$P(PSOPAR,"^",12) D
    104         ..D FIELD^DID(52,DR,"","LABEL","ZZ") S PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR) K ZZ
    105         ..S DR=35,DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ,DIRUT,DUOUT,DTOUT
    106         ..S:$G(PSORXED(52,DA,DR))]"" DIR("B")=PSORXED(52,DA,DR)
    107         ..S DIR(0)="52,"_(DR) D ^DIR I $D(DIRUT),X'="@" K DIR,DIRUT Q
    108         ..S PSORXED("FLD",DR)=X K DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)
    109         .I $G(PSORXED("FLD",DR))]"" D FIELD^DID(52,DR,"","LABEL","ZZ") S PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR) K ZZ
    110         Q:$G(PSOSIGFL)
    111         S (RX1,I,RFD,RFDT)=0 F  S I=$O(^PSRX(PSORXED("IRXN"),1,I)) Q:'I  S RFD=I,RFDT=$P(^PSRX(PSORXED("IRXN"),1,I,0),"^"),RX1(I)=$G(RX1(I))+1
    112         Q
    113 CHK     S CHK=1 I $G(^PSDRUG($P(PSORXED("RX0"),"^",6),"I"))]"",^("I")<DT S VALMSG="This drug has been inactivated. ",PSORXED("DFLG")=1 Q
    114         K PSPOP I $G(PSODIV),$P(PSORXED("RX2"),"^",9)'=PSOSITE S PSPRXN=PSORXED("IRXN") D  Q:PSORXED("DFLG")
    115         .I '$P(PSOSYS,"^",2) S VALMSG="RX# "_$P(^PSRX(PSPRXN,0),"^")_" is not a valid choice. (Different Division)" S PSORXED("DFLG")=1 Q
    116         .I $P(PSOSYS,"^",3) K DIR,DUOUT,DTOUT D  K DIR,DUOUT,DTOUT Q
    117         ..W $C(7) S DIR("A",1)="",DIR("A",2)="RX# "_$P(^PSRX(PSPRXN,0),"^")_" is from another division.",DIR("A")="Continue: (Y/N)",DIR(0)="Y",DIR("?",1)="'Y' FOR YES",DIR("?")="'N' FOR NO"
    118         ..S DIR("B")="N" D ^DIR I 'Y!($D(DIRUT)) S PSORXED("DFLG")=1 W !
    119         ;
    120         I $P(^PSRX(PSORXED("IRXN"),"STA"),"^")=14!($P(^("STA"),"^")=15) S PSORXED("DFLG")=1 S VALMSG="Discontinued prescriptions cannot be edited." Q
    121         ;WVEHR ;begin p208
    122         S DIC="^VA(200,",DIC(0)="QEZ",X="AUTOFINISH,RX" ;vfah
    123         D ^DIC K DIC ;vfah
    124         S PSOZAF=+Y ;vfah
    125         I $P($G(^PSRX(PSORXED("IRXN"),"OR1")),"^",5)=$G(PSOZAF) S PSORXED("DFLG")=1 S VALMSG="EDIT option is not available for Autofinshed Rxs" K PSOZAF Q  ;vfah
    126         ;WVEHR ;end p208
    127         I $P(^PSRX(PSORXED("IRXN"),"STA"),"^")=16 S PSORXED("DFLG")=1 S VALMSG="Prescriptions on Provider Hold cannot be edited." Q
    128 CHKX    K PSPOP,DIR,DTOUT,DUOUT,Y,X Q
    129         Q
    130 PROV    ;select provider
    131         S PSORXED("PROVIDER")=$P(RX0,"^",4),PSORXED("PROVIDER NAME")=$P(^VA(200,$P(RX0,"^",4),0),"^")
    132         D PROV^PSODIR(.PSORXED) I PSORXED("PROVIDER")'=$P(RX0,"^",4) D
    133         .K DIR,DIRUT W ! S DIR(0)="Y",DIR("A",1)="You have changed the name of the provider entered for this Rx."
    134         .S DIR("A",2)="This edit will cause the provider's name to be update for all fills.",DIR("A")="Do you want to continue" D ^DIR
    135         .I 'Y!$D(DIRUT) K PSORX("PROVIDER"),PSORX("PROVIDER NAME"),PSORX("COSIGNING PROVIDER") Q
    136         .S PSORXED("FLD",4)=PSORXED("PROVIDER") K DIR,DIRUT,DUOUT
    137         .S PSORXED("FLD",109)=$G(PSORXED("COSIGNING PROVIDER"))
    138         Q
    139 UDPROV  ;update provider
    140         S $P(^PSRX(PSORXED("IRXN"),0),"^",4)=PSORXED("PROVIDER"),$P(^(3),"^",3)=$G(PSORX("COSIGNING PROVIDER"))
    141         F XTY="1","P" F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),XTY,I)) Q:'I  S $P(^PSRX(PSORXED("IRXN"),XTY,I,0),"^",17)=PSORXED("PROVIDER") S:XTY RFED=I
    142         K XTY,I
    143         Q
    144 SIG     ;edit medication instructions (SIG)
    145         S PSOFDR=+$P(^PSRX(PSORXED("IRXN"),"SIG"),"^",2) I PSOFDR D
    146         .F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),"SIG1",I)) Q:'I  S SIG(I)=^PSRX(PSORXED("IRXN"),"SIG1",I,0)
    147         E  S PSORX("SIG")=$P(^PSRX(PSORXED("IRXN"),"SIG"),"^")
    148         D SIG^PSODIR1(.PSORX) D:$G(PSORX("SIG"))]"" EN1^PSOSIGNO(PSORXED("IRXN"),PSORX("SIG"))
    149         I '$G(PSOSIGFL),$G(PSORX("SIG"))]"" S ^PSRX(PSORXED("IRXN"),"SIG")=PSORX("SIG") K ^PSRX(PSORXED("IRXN"),"SIG1") Q
    150         S PSOMRFLG=1
    151         Q
    152 UL      ;
    153         I '$G(PSOLOKED) Q
    154         D UL^PSSLOCK(PSODFN)
    155         D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
    156         Q
    157 SVAL    ;Set message for patient lock
    158         S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.")
    159         Q
    160 SVALO   ;Set message for order lock
    161         S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order.")
    162         Q
    163         ;
     1PSOOREDT ;BIR/SAB - edit orders from backdoor ;1/27/07  13:22
     2 ;;7.0;OUTPATIENT PHARMACY;**4,20,27,37,57,46,78,102,104,119,143,148,208**;DEC 1997;Build 39
     3 ; Modified from FOIA VISTA,
     4 ; Copyright (C) 2007 WorldVistA
     5 ;
     6 ; This program is free software; you can redistribute it and/or modify
     7 ; it under the terms of the GNU General Public License as published by
     8 ; the Free Software Foundation; either version 2 of the License, or
     9 ; (at your option) any later version.
     10 ;
     11 ;External reference to ^PSDRUG supported by DBIA 221
     12 ;External reference to PSSLOCK supported by DBIA 2789
     13 ;External reference to ^VA(200 supported by DBIA 10060
     14SEL K PSOISLKD,PSOLOKED S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY D SVAL K PSOPLCK S VALMBCK="" Q
     15 K PSOPLCK D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) D UL^PSSLOCK(+$G(PSODFN)) D SVALO K PSOMSG S VALMBCK="" Q
     16 K PSOMSG S PSOLOKED=1
     17 K PSORX("DFLG"),DIR,DUOUT,DIRUT S DIR("A")="Select fields by number"
     18 S DIR(0)="LO^1:"_$S($$STATUS^PSOBPSUT($P(PSOLST(ORN),"^",2))'="":21,$G(REF):20,1:19)
     19 D ^DIR I $D(DIRUT) K DIR,DIRUT,DTOUT S VALMBCK="" D UL K PSOLOKED Q
     20EDTSEL N VALMCNT K PSOISLKD,PSORX("DFLG"),PSOOIFLG,PSOMRFLG,DIR,DIRUT,DTOUT,DTOUT,ZONE S (PSOEDIT,PSORXED)=1 I +Y S FST=Y D HLDHDR^PSOLMUTL D  G EX ;PSO LM SELECT MENU protocol
     21 .I '$G(PSOLOKED) S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY D SVAL K PSOPLCK S VALMBCK="",(PSOISLKD,PSODE)=1 Q
     22 .I '$G(PSOLOKED) K PSOPLCK D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) D UL^PSSLOCK(+$G(PSODFN)) D SVALO K PSOMSG S VALMBCK="",(PSOISLKD,PSODE)=1 Q
     23 .K PSOMSG,PSOPLCK S (NEWEDT,PSOLOKED)=1 D EDT
     24 E  S VALMBCK="",PSODE=1
     25EX I $G(PSOISLKD) D UL K PSOISLKD G EX2
     26 I '$G(PSOSIGFL),'$G(PSORXED("DFLG")) D UPDATE^PSOORED6 D LOG^PSORXED,POST^PSORXED G EX1
     27 I $G(PSOSIGFL)=1 D  Q:$G(PSORX("FN"))
     28 .N PSOTMP
     29 .S PSOTMP=$G(PSOFROM),PSOFROM="NEW"
     30 .S VALMSG="This change will create a new prescription!",NCPDPFLG=1
     31 .D EN^PSOORED1(.PSORXED)
     32 .I $G(PSORX("FN")) D  Q
     33 ..D ^PSOBUILD
     34 ..K QUIT,PSORX("DFLG"),FST,FLD,IEN,FLN,INCOM,PSOI,PSODRUG,PSOEDIT
     35 ..K PSORENW,PSOSIGFL,PSOOIFLG,PSOMRFLG,PSODIR,CHK,PSORX("SIG"),PSODE
     36 ..K PSOTRN,PSORX("EDIT"),PSORXED("FLD"),NEWEDT
     37 ..D EOJ^PSONEW
     38 ..D UL K PSOLOKED S VALMBCK="Q"
     39 .S PSOFROM=PSOTMP I PSOFROM="" K PSOFROM
     40 ;
     41EX1 I '$G(PSODE)!('$G(ZONE)) I $G(PSORENW("OIRXN")) D EN^PSOHLSN1(PSORENW("OIRXN"),"XX","","Order edited")
     42QUIT D UL K PSOLOKED D ^PSOBUILD,ACT^PSOORNE2 D:+^PSRX($P(PSOLST(ORN),"^",2),"STA")=5 EN^PSOCMOPC($P(PSOLST(ORN),"^",2))
     43 K:'$O(^PSRX($P(PSOLST(ORN),"^",2),1,0)) REF
     44EX2 S VALMBCK=$S($G(PSORX("FN")):"Q",$G(ZONE):"Q",1:"R") K PSORXED,FST,FLD,IEN,FLN,INCOM,PSOI,PSODRUG,PSOEDIT,PSORENW,PSOSIGFL,PSODIR,CHK,PSORX("SIG"),PSODE,PSOTRN,PSORX("DFLG"),RFED,ZONE,PSORX("EDIT"),PSOOIFLG,PSOMRFLG,SIG,QUIT
     45 K NEWEDT I $G(VALMBCK)="R" W ! D CLEAN^PSOVER1 H 2
     46 Q
     47 ;
     48EDT S NCPDPFLG=0
     49 S I=0 F  S I=$O(^PSRX($P(PSOLST(ORN),"^",2),1,I)) Q:'I  S PSORXED("RX1")=^PSRX($P(PSOLST(ORN),"^",2),1,I,0)
     50 S (RX0,PSORXED("RX0"))=^PSRX($P(PSOLST(ORN),"^",2),0),PSORXED("RX2")=$G(^(2)),PSORXED("RX3")=$G(^(3)),PSOSIG=$P(^("SIG"),"^")
     51 F FLD=1:1:$L(FST,",") Q:$P(FST,",",FLD)']""!($G(PSORXED("DFLG")))!($G(PSORX("DFLG")))  S FLN=+$P(FST,",",FLD) D
     52 .S PSORXED("DFLG")=0,(DA,PSORXED("IRXN"),PSORENW("OIRXN"))=$P(PSOLST(ORN),"^",2),RX0=^PSRX(PSORXED("IRXN"),0) S:$G(PSOSIG)="" PSOSIG=$P(^("SIG"),"^")
     53 .I '$G(PSOSIGFL) D
     54 ..S PSOI=+^PSRX(DA,"OR1"),PSODAYS=$P(RX0,"^",8),PSORXST=+$P($G(^PS(53,$P(RX0,"^",3),0)),"^",7)
     55 ..I 'PSOI S PSOI=+^PSDRUG($P(RX0,"^",6),2),$P(^PSRX(DA,"OR1"),"^")=PSOI
     56 ..S:'$G(PSODRUG("IEN")) PSODRUG("IEN")=$P(RX0,"^",6),PSODRUG("NAME")=$P(^PSDRUG($P(RX0,"^",6),0),"^")
     57 ..S PSODRUG("OI")=PSOI
     58 .S PSORX("PROVIDER")=$P(RX0,"^",4),PSORX("PROVIDER NAME")=$P(^VA(200,$P(RX0,"^",4),0),"^"),PSOTRN=$G(^PSRX(DA,"TN"))
     59 .D:'$G(CHK) POP^PSOSIGNO(DA),CHK Q:$G(PSORXED("DFLG"))
     60 .S FDR="39.2^"_$S($P(PSOPAR,"^",3):"6",1:"")_";6.5^113^114^3^1^22R^24^8^7^9^4^11;"_$S($P(RX0,"^",11)="W"&($P(PSOPAR,"^",12)):"35;",1:"")_"^10.6^5^20^23^12^PSOCOU^RF^81"
     61 .I FLN=20,'$G(REF) S VALMSG="There is no Refill Data to be edited." Q
     62 .S DR=$P(FDR,"^",FLN) I DR="RF" D REF^PSOORED2 Q
     63 .I DR="PSOCOU" D PSOCOU^PSOORED6 Q
     64 .I FLN=2,'$P(PSOPAR,"^",3) D  Q
     65 ..N NDC D NDC^PSODRG(RXN,0,,.NDC) I $G(NDC)="^"!($G(NDC)="") Q
     66 ..S (PSODRUG("NDC"),PSORXED("FLD",27))=NDC
     67 .I FLN'>2,'$P(PSOPAR,"^",3) S VALMSG="Check site parameters, Drug data is not editable." Q
     68 .I FLN=3 D EDTDOSE^PSOORED2 Q
     69 .I FLN=4 D INS^PSOORED1 Q
     70 .I FLN=1 D PSOI^PSOORED6 N PSOX S PSORXED=1,PSOX("IRXN")=$S($D(DA):DA,$D(PSORXED("IRXN")):PSORXED("IRXN"),$D(PSORENW("OIRXN")):PSORENW("OIRXN")) D:'$G(PSORXED("DFLG")) EN^PSODIAG Q
     71 .I FLN=2 D DRG^PSOORED6 N PSOX S PSORXED=1,PSOX("IRXN")=PSORXED("IRXN") D:'$G(PSORXED("DFLG")) EN^PSODIAG S:$O(^PSRX(PSORXED("IRXN"),1,0)) REF=1 Q
     72 .I FLN=12 D PROV Q
     73 .I FLN=6 D ISDT^PSOORED2 Q
     74 .I FLN=7 D FLDT^PSOORED2 Q
     75 .I FLN=21,$$STATUS^PSOBPSUT(RXN,0)="" S VALMSG="Invalid selection!" Q
     76 .I FLN=21 D  Q
     77 ..N DAW D EDTDAW^PSODAWUT(RXN,0,.DAW) I $G(DAW)="^" Q
     78 ..S (PSODRUG("DAW"),PSORXED("FLD",81))=DAW
     79 .I FLN=9!(FLN=10)!(FLN=11) D NOCHG^PSOORED7 Q
     80 .S DR=+DR
     81 .K DIR,DIRUT,DIROUT ;S DIE=52 D ^DIE I $D(Y) S PSORXED("DFLG")=1
     82 .K DIC,DIQ S DIC=52,DA=PSORXED("IRXN"),DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ
     83 .S DIR("B")=$S($G(PSORXED("FLD",DR))]"":PSORXED("FLD",DR),1:PSORXED(52,DA,DR)),DIR(0)="52,"_DR D ^DIR
     84 .I DR=24!(DR=12) S PSORXED("FLD",DR)=X
     85 .I $D(DIRUT) K DIR,DIRUT,DUOUT,DTOUT,PSORXED(52,DA,DR),PSORXED("FLD",DR) Q
     86 .I DR'=5,X="@" W !,"Data Required!",! K DIC,DIQ,DR,DA,DIR,DIRUT,PSORXED(52,DA,DR),X,Y Q
     87 .I DR=5,X'="@" S Y=+Y
     88 .I DR=3!(DR=20)!(DR=23) S Y=+Y
     89 .S PSORXED("FLD",DR)=$S(X="@":X,1:Y) K DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)
     90 .I DR=11,PSORXED("FLD",DR)="W",$P(PSOPAR,"^",12) D
     91 ..D FIELD^DID(52,DR,"","LABEL","ZZ") S PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR) K ZZ
     92 ..S DR=35,DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ,DIRUT,DUOUT,DTOUT
     93 ..S:$G(PSORXED(52,DA,DR))]"" DIR("B")=PSORXED(52,DA,DR)
     94 ..S DIR(0)="52,"_(DR) D ^DIR I $D(DIRUT),X'="@" K DIR,DIRUT Q
     95 ..S PSORXED("FLD",DR)=X K DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)
     96 .I $G(PSORXED("FLD",DR))]"" D FIELD^DID(52,DR,"","LABEL","ZZ") S PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR) K ZZ
     97 Q:$G(PSOSIGFL)
     98 S (RX1,I,RFD,RFDT)=0 F  S I=$O(^PSRX(PSORXED("IRXN"),1,I)) Q:'I  S RFD=I,RFDT=$P(^PSRX(PSORXED("IRXN"),1,I,0),"^"),RX1(I)=$G(RX1(I))+1
     99 Q
     100CHK S CHK=1 I $G(^PSDRUG($P(PSORXED("RX0"),"^",6),"I"))]"",^("I")<DT S VALMSG="This drug has been inactivated. ",PSORXED("DFLG")=1 Q
     101 K PSPOP I $G(PSODIV),$P(PSORXED("RX2"),"^",9)'=PSOSITE S PSPRXN=PSORXED("IRXN") D  Q:PSORXED("DFLG")
     102 .I '$P(PSOSYS,"^",2) S VALMSG="RX# "_$P(^PSRX(PSPRXN,0),"^")_" is not a valid choice. (Different Division)" S PSORXED("DFLG")=1 Q
     103 .I $P(PSOSYS,"^",3) K DIR,DUOUT,DTOUT D  K DIR,DUOUT,DTOUT Q
     104 ..W $C(7) S DIR("A",1)="",DIR("A",2)="RX# "_$P(^PSRX(PSPRXN,0),"^")_" is from another division.",DIR("A")="Continue: (Y/N)",DIR(0)="Y",DIR("?",1)="'Y' FOR YES",DIR("?")="'N' FOR NO"
     105 ..S DIR("B")="N" D ^DIR I 'Y!($D(DIRUT)) S PSORXED("DFLG")=1 W !
     106 ;
     107 I $P(^PSRX(PSORXED("IRXN"),"STA"),"^")=14!($P(^("STA"),"^")=15) S PSORXED("DFLG")=1 S VALMSG="Discontinued prescriptions cannot be edited." Q
     108 ;
     109 S DIC="^VA(200,",DIC(0)="QEZ",X="AUTOFINISH,RX" ;vfah
     110 D ^DIC K DIC ;vfah
     111 S PSOZAF=+Y ;vfah
     112 I $P($G(^PSRX(PSORXED("IRXN"),"OR1")),"^",5)=$G(PSOZAF) S PSORXED("DFLG")=1 S VALMSG="EDIT option is not available for Autofinshed Rxs" K PSOZAF Q  ;vfah
     113 ;
     114 I $P(^PSRX(PSORXED("IRXN"),"STA"),"^")=16 S PSORXED("DFLG")=1 S VALMSG="Prescriptions on Provider Hold cannot be edited." Q
     115CHKX K PSPOP,DIR,DTOUT,DUOUT,Y,X Q
     116 Q
     117PROV ;select provider
     118 S PSORXED("PROVIDER")=$P(RX0,"^",4),PSORXED("PROVIDER NAME")=$P(^VA(200,$P(RX0,"^",4),0),"^")
     119 D PROV^PSODIR(.PSORXED) I PSORXED("PROVIDER")'=$P(RX0,"^",4) D
     120 .K DIR,DIRUT W ! S DIR(0)="Y",DIR("A",1)="You have changed the name of the provider entered for this Rx."
     121 .S DIR("A",2)="This edit will cause the provider's name to be update for all fills.",DIR("A")="Do you want to continue" D ^DIR
     122 .I 'Y!$D(DIRUT) K PSORX("PROVIDER"),PSORX("PROVIDER NAME"),PSORX("COSIGNING PROVIDER") Q
     123 .S PSORXED("FLD",4)=PSORXED("PROVIDER") K DIR,DIRUT,DUOUT
     124 .S PSORXED("FLD",109)=$G(PSORXED("COSIGNING PROVIDER"))
     125 Q
     126UDPROV ;update provider
     127 S $P(^PSRX(PSORXED("IRXN"),0),"^",4)=PSORXED("PROVIDER"),$P(^(3),"^",3)=$G(PSORX("COSIGNING PROVIDER"))
     128 F XTY="1","P" F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),XTY,I)) Q:'I  S $P(^PSRX(PSORXED("IRXN"),XTY,I,0),"^",17)=PSORXED("PROVIDER") S:XTY RFED=I
     129 K XTY,I
     130 Q
     131SIG ;edit medication instructions (SIG)
     132 S PSOFDR=+$P(^PSRX(PSORXED("IRXN"),"SIG"),"^",2) I PSOFDR D
     133 .F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),"SIG1",I)) Q:'I  S SIG(I)=^PSRX(PSORXED("IRXN"),"SIG1",I,0)
     134 E  S PSORX("SIG")=$P(^PSRX(PSORXED("IRXN"),"SIG"),"^")
     135 D SIG^PSODIR1(.PSORX) D:$G(PSORX("SIG"))]"" EN1^PSOSIGNO(PSORXED("IRXN"),PSORX("SIG"))
     136 I '$G(PSOSIGFL),$G(PSORX("SIG"))]"" S ^PSRX(PSORXED("IRXN"),"SIG")=PSORX("SIG") K ^PSRX(PSORXED("IRXN"),"SIG1") Q
     137 S PSOMRFLG=1
     138 Q
     139UL ;
     140 I '$G(PSOLOKED) Q
     141 D UL^PSSLOCK(PSODFN)
     142 D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
     143 Q
     144SVAL ;Set message for patient lock
     145 S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.")
     146 Q
     147SVALO ;Set message for order lock
     148 S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order.")
     149 Q
     150 ;
Note: See TracChangeset for help on using the changeset viewer.