Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOOREDT

PSOOREDT.m

Go to the documentation of this file. 
  1. PSOOREDT ;BIR/SAB - edit orders from backdoor ;10-Jun-2013 22:29;DU
  1.  ;;7.0;OUTPATIENT PHARMACY;**4,20,27,37,57,46,78,102,104,119,1002,1008,1013,143,148,260,281,304,289,1015,1016,1017**;DEC 1997;Build 40
  1.  ;External reference to ^PSDRUG supported by DBIA 221
  1.  ;External reference to PSSLOCK supported by DBIA 2789
  1.  ;External reference to ^VA(200 supported by DBIA 10060
  1.  ; Modified - IHS/CIA/PLS - 01/15/04 - Lines SEL+3
  1.  ;                        - 12/13/04 - Line EDT+13
  1.  ;            IHS/MSC/PLS - 01/27/09 - Line EDT+20, EDT+21
  1.  ;                          02/15/12 - Line PROV+1
  1.  ;            IHS/MSC/PB  - 01/22/13 - Line SEL+1 modified to screen for external Rx and not allow it to be edited.
  1.  ;            IHS/MSC/PLS - 06/04/13 - Line EDT+23
  1. SEL ;
  1.  ;IHS/MSC/PB start code to screen for external Rx to be edited 1/22/13
  1.  I $E($P($G(^PSRX($P(PSOLST(ORN),"^",2),0)),"^",1))="X" D  Q
  1.  .W !,"An external Rx can't be Edited in RPMS Prescription Processing."
  1.  .W !,"Use Copy to create a new internal Rx from this external Rx."
  1.  .S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR
  1.  ;ISH/MSC/PB end changes for screen of external Rx for editing
  1.  K PSOISLKD,PSOLOKED S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY D SVAL K PSOPLCK S VALMBCK="" Q
  1.  K PSOPLCK D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) D UL^PSSLOCK(+$G(PSODFN)) D SVALO K PSOMSG S VALMBCK="" Q
  1.  K PSOMSG S PSOLOKED=1
  1.  K PSORX("DFLG"),DIR,DUOUT,DIRUT S DIR("A")="Select fields by number"
  1.  ;IHS/CIA/PLS - 01/15/04 - Commented out next line and modified the numeric range
  1.  ;S DIR(0)="LO^1:"_$S($$STATUS^PSOBPSUT($P(PSOLST(ORN),"^",2))'="":21,$G(REF):20,1:19)
  1.  S DIR(0)="LO^0:"_$S($$STATUS^PSOBPSUT($P(PSOLST(ORN),"^",2))'="":21,$G(REF):20,1:19)
  1.  D ^DIR I $D(DIRUT) K DIR,DIRUT,DTOUT S VALMBCK="" D UL K PSOLOKED Q
  1. 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
  1.  N VALMCNT K PSOISLKD,PSORX("DFLG"),PSOOIFLG,PSOMRFLG,DIR,DIRUT,DTOUT,ZONE S (PSOEDIT,PSORXED)=1 I $L(Y) S FST=Y D HLDHDR^PSOLMUTL D  G EX ;PSO LM SELECT MENU protocol
  1.  .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
  1.  .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
  1.  .K PSOMSG,PSOPLCK S (NEWEDT,PSOLOKED)=1 D EDT
  1.  E  S VALMBCK="",PSODE=1
  1. EX I $G(PSOISLKD) D UL K PSOISLKD G EX2
  1.  I '$G(PSOSIGFL),'$G(PSORXED("DFLG")) D UPDATE^PSOORED6 D LOG^PSORXED,POST^PSORXED G EX1
  1.  I $G(PSOSIGFL)=1 D  Q:$G(PSORX("FN"))
  1.  .N PSOTMP
  1.  .S PSOTMP=$G(PSOFROM),PSOFROM="NEW"
  1.  .S VALMSG="This change will create a new prescription!",NCPDPFLG=1
  1.  .D EN^PSOORED1(.PSORXED)
  1.  .I $G(PSORX("FN")) D  Q
  1.  ..D ^PSOBUILD
  1.  ..K QUIT,PSORX("DFLG"),FST,FLD,IEN,FLN,INCOM,PSOI,PSODRUG,PSOEDIT
  1.  ..K PSORENW,PSOSIGFL,PSOOIFLG,PSOMRFLG,PSODIR,CHK,PSORX("SIG"),PSODE
  1.  ..K PSOTRN,PSORX("EDIT"),PSORXED("FLD"),NEWEDT
  1.  ..D EOJ^PSONEW
  1.  ..D UL K PSOLOKED S VALMBCK="Q"
  1.  .S PSOFROM=PSOTMP I PSOFROM="" K PSOFROM
  1.  ;
  1. EX1 I '$G(PSODE)!('$G(ZONE)) I $G(PSORENW("OIRXN")) D EN^PSOHLSN1(PSORENW("OIRXN"),"XX","","Order edited")
  1. QUIT D UL K PSOLOKED D ^PSOBUILD,ACT^PSOORNE2 D:+^PSRX($P(PSOLST(ORN),"^",2),"STA")=5 EN^PSOCMOPC($P(PSOLST(ORN),"^",2))
  1.  K:'$O(^PSRX($P(PSOLST(ORN),"^",2),1,0)) REF
  1. 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
  1.  K NEWEDT I $G(VALMBCK)="R" W ! D CLEAN^PSOVER1 H 2
  1.  Q
  1.  ;
  1. EDT ; Rx Edit (Backdoor)
  1.  K NCPDPFLG
  1.  I '$D(PSODRUG) NEW PSOY S PSOY=$P(RX0,U,6),PSOY(0)=^PSDRUG(PSOY,0) D SET^PSODRG
  1.  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)
  1.  S (RX0,PSORXED("RX0"))=^PSRX($P(PSOLST(ORN),"^",2),0),PSORXED("RX2")=$G(^(2)),PSORXED("RX3")=$G(^(3)),PSOSIG=$P(^("SIG"),"^")
  1.  F FLD=1:1:$L(FST,",") Q:$P(FST,",",FLD)']""!($G(PSORXED("DFLG")))!($G(PSORX("DFLG")))  S FLN=+$P(FST,",",FLD) D
  1.  .S PSORXED("DFLG")=0,(DA,PSORXED("IRXN"),PSORENW("OIRXN"))=$P(PSOLST(ORN),"^",2),RX0=^PSRX(PSORXED("IRXN"),0) S:$G(PSOSIG)="" PSOSIG=$P(^("SIG"),"^")
  1.  .I '$G(PSOSIGFL) D
  1.  ..S PSOI=+^PSRX(DA,"OR1"),PSODAYS=$P(RX0,"^",8),PSORXST=+$P($G(^PS(53,$P(RX0,"^",3),0)),"^",7)
  1.  ..I 'PSOI S PSOI=+^PSDRUG($P(RX0,"^",6),2),$P(^PSRX(DA,"OR1"),"^")=PSOI
  1.  ..S:'$G(PSODRUG("IEN")) PSODRUG("IEN")=$P(RX0,"^",6),PSODRUG("NAME")=$P(^PSDRUG($P(RX0,"^",6),0),"^")
  1.  ..S PSODRUG("OI")=PSOI
  1.  .S PSORX("PROVIDER")=$P(RX0,"^",4),PSORX("PROVIDER NAME")=$P(^VA(200,$P(RX0,"^",4),0),"^"),PSOTRN=$G(^PSRX(DA,"TN"))
  1.  .D:'$G(CHK) POP^PSOSIGNO(DA),CHK Q:$G(PSORXED("DFLG"))
  1.  .; IHS/CIA/PLS - 03/14/04 - Edit IHS specific Fields
  1.  .I FLN=0 D  Q
  1.  ..S PSORXED("CM")=$$GET1^DIQ(52,PSORXED("IRXN"),9999999.02,"I")  ; IHS/CIA/PLS - 12/13/04 - Added internal flag
  1.  ..S PSORXED("MANUFACTURER")=$$GET1^DIQ(52,PSORXED("IRXN"),28)
  1.  ..S PSORXED("EXPIRATION DATE")=$$GET1^DIQ(52,PSORXED("IRXN"),29,"I")
  1.  ..S PSORXED("TRIP")=$$GET1^DIQ(52,PSORXED("IRXN"),9999999.14)
  1.  ..S PSORXED("LOT #")=$$GET1^DIQ(52,PSORXED("IRXN"),24)
  1.  ..S PSORXED("DAW")=$$GET1^DIQ(52,PSORXED("IRXN"),9999999.25,"I")
  1.  ..S PSORXED("CASH DUE")=$$GET1^DIQ(52,PSORXED("IRXN"),9999999.26)
  1.  ..S PSORXED("DSCMED")=$$GET1^DIQ(52,PSORXED("IRXN"),9999999.28,"I")  ;IHS/MSC/PLS - 06/04/13
  1.  ..D IHSFLDS^APSPDIR(.PSORXED,1)
  1.  .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"
  1.  .I $G(ST)=11!($G(ST)=12)!($G(ST)=14)!($G(ST)=15) D NDCDAWDE^PSOORED7(ST,FLN,$G(RXN)) Q
  1.  .I FLN=20,'$G(REF) S VALMSG="There is no Refill Data to be edited." Q
  1.  .S DR=$P(FDR,"^",FLN) I DR="RF" D REF^PSOORED2 Q
  1.  .I DR="PSOCOU" D PSOCOU^PSOORED6 Q
  1.  .I FLN=2,'$P(PSOPAR,"^",3),$$RXRLDT^PSOBPSUT(RXN,0),$$STATUS^PSOBPSUT(RXN,0)'="" D  Q
  1.  ..N NDC D NDC^PSODRG(RXN,0,,.NDC) I $G(NDC)="^"!($G(NDC)="") Q
  1.  ..S (PSODRUG("NDC"),PSORXED("FLD",27))=NDC
  1.  .I FLN'>2,'$P(PSOPAR,"^",3) S VALMSG="Check site parameters, Drug data is not editable." Q
  1.  .I FLN=3 D EDTDOSE^PSOORED2,FULL^VALM1,POST^PSODRG S:$G(PSORX("DFLG")) PSOISLKD=1,PSORX("FN")=1 Q
  1.  .I FLN=4 D INS^PSOORED1 Q
  1.  .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
  1.  .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
  1.  .I FLN=12 D PROV Q
  1.  .I FLN=6 D ISDT^PSOORED2 Q
  1.  .I FLN=7 D FLDT^PSOORED2 Q
  1.  .I FLN=21,$$STATUS^PSOBPSUT(RXN,0)="" S VALMSG="Invalid selection!" Q
  1.  .I FLN=21 D  Q
  1.  ..N DAW D EDTDAW^PSODAWUT(RXN,0,.DAW) I $G(DAW)="^" Q
  1.  ..S (PSODRUG("DAW"),PSORXED("FLD",81))=DAW
  1.  .I FLN=9!(FLN=10)!(FLN=11) D NOCHG^PSOORED7 Q
  1.  .S DR=+DR
  1.  .K DIR,DIRUT,DIROUT ;S DIE=52 D ^DIE I $D(Y) S PSORXED("DFLG")=1
  1.  .K DIC,DIQ S DIC=52,DA=PSORXED("IRXN"),DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ
  1.  .S DIR("B")=$S($G(PSORXED("FLD",DR))]"":PSORXED("FLD",DR),1:PSORXED(52,DA,DR)),DIR(0)="52,"_DR D ^DIR
  1.  .I DR=24!(DR=12) S PSORXED("FLD",DR)=X
  1.  .I $D(DIRUT) K DIR,DIRUT,DUOUT,DTOUT,PSORXED(52,DA,DR),PSORXED("FLD",DR) Q
  1.  .I DR'=5,X="@" W !,"Data Required!",! K DIC,DIQ,DR,DA,DIR,DIRUT,PSORXED(52,DA,DR),X,Y Q
  1.  .I DR=5,X'="@" S Y=+Y
  1.  .I DR=3!(DR=20)!(DR=23) S Y=+Y
  1.  .S PSORXED("FLD",DR)=$S(X="@":X,1:Y) K DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)
  1.  .I DR=11,PSORXED("FLD",DR)="W",$P(PSOPAR,"^",12) D
  1.  ..D FIELD^DID(52,DR,"","LABEL","ZZ") S PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR) K ZZ
  1.  ..S DR=35,DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ,DIRUT,DUOUT,DTOUT
  1.  ..S:$G(PSORXED(52,DA,DR))]"" DIR("B")=PSORXED(52,DA,DR)
  1.  ..S DIR(0)="52,"_(DR) D ^DIR I $D(DIRUT),X'="@" K DIR,DIRUT Q
  1.  ..S PSORXED("FLD",DR)=X K DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)
  1.  .I $G(PSORXED("FLD",DR))]"" D FIELD^DID(52,DR,"","LABEL","ZZ") S PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR) K ZZ
  1.  Q:$G(PSOSIGFL)
  1.  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
  1.  Q
  1. 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
  1.  K PSPOP I $G(PSODIV),$P(PSORXED("RX2"),"^",9)'=PSOSITE S PSPRXN=PSORXED("IRXN") D  Q:PSORXED("DFLG")
  1.  .I '$P(PSOSYS,"^",2) S VALMSG="RX# "_$P(^PSRX(PSPRXN,0),"^")_" is not a valid choice. (Different Division)" S PSORXED("DFLG")=1 Q
  1.  .I $P(PSOSYS,"^",3) K DIR,DUOUT,DTOUT D  K DIR,DUOUT,DTOUT Q
  1.  ..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"
  1.  ..S DIR("B")="N" D ^DIR I 'Y!($D(DIRUT)) S PSORXED("DFLG")=1 W !
  1.  ;
  1.  I $P(^PSRX(PSORXED("IRXN"),"STA"),"^")=16 S PSORXED("DFLG")=1 S VALMSG="Prescriptions on Provider Hold cannot be edited." Q
  1. CHKX K PSPOP,DIR,DTOUT,DUOUT,Y,X Q
  1.  Q
  1. PROV ;select provider
  1.  S:$$ISSCH^APSPFNC2($G(PSODRUG("IEN")),"2345") PSORXED("CS")=1  ;IHS/MSC/PLS - 02/15/2012
  1.  S PSORXED("PROVIDER")=$P(RX0,"^",4),PSORXED("PROVIDER NAME")=$P(^VA(200,$P(RX0,"^",4),0),"^")
  1.  D PROV^PSODIR(.PSORXED) I PSORXED("PROVIDER")'=$P(RX0,"^",4) D
  1.  .K DIR,DIRUT W ! S DIR(0)="Y",DIR("A",1)="You have changed the name of the provider entered for this Rx."
  1.  .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
  1.  .I 'Y!$D(DIRUT) K PSORX("PROVIDER"),PSORX("PROVIDER NAME"),PSORX("COSIGNING PROVIDER") Q
  1.  .S PSORXED("FLD",4)=PSORXED("PROVIDER") K DIR,DIRUT,DUOUT
  1.  .S PSORXED("FLD",109)=$G(PSORXED("COSIGNING PROVIDER"))
  1.  Q
  1. UDPROV ;update provider
  1.  S $P(^PSRX(PSORXED("IRXN"),0),"^",4)=PSORXED("PROVIDER"),$P(^(3),"^",3)=$G(PSORX("COSIGNING PROVIDER"))
  1.  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
  1.  K XTY,I
  1.  Q
  1. SIG ;edit medication instructions (SIG)
  1.  S PSOFDR=+$P(^PSRX(PSORXED("IRXN"),"SIG"),"^",2) I PSOFDR D
  1.  .F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),"SIG1",I)) Q:'I  S SIG(I)=^PSRX(PSORXED("IRXN"),"SIG1",I,0)
  1.  E  S PSORX("SIG")=$P(^PSRX(PSORXED("IRXN"),"SIG"),"^")
  1.  D SIG^PSODIR1(.PSORX) D:$G(PSORX("SIG"))]"" EN1^PSOSIGNO(PSORXED("IRXN"),PSORX("SIG"))
  1.  I '$G(PSOSIGFL),$G(PSORX("SIG"))]"" S ^PSRX(PSORXED("IRXN"),"SIG")=PSORX("SIG") K ^PSRX(PSORXED("IRXN"),"SIG1") Q
  1.  S PSOMRFLG=1
  1.  Q
  1. UL ;
  1.  I '$G(PSOLOKED) Q
  1.  D UL^PSSLOCK(PSODFN)
  1.  D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
  1.  Q
  1. SVAL ;Set message for patient lock
  1.  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.")
  1.  Q
  1. SVALO ;Set message for order lock
  1.  S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order.")
  1.  Q
  1.  ;