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

PSOORED6.m

Go to the documentation of this file. 
  1. PSOORED6 ;BIR/SAB - edit orders from backdoor ;Mar 28, 2022@14:32:09
  1.  ;;7.0;OUTPATIENT PHARMACY;**78,104,117,133,143,219,148,247,268,260,269,251,372,422,574,441,703,753**;DEC 1997;Build 53
  1.  ;Reference to ^PSDRUG supported by DBIA 221
  1.  ;Reference to ^PS(50.7 supported by DBIA 2223
  1.  ;Reference ^PS(50.606 supported by DBIA 2174
  1. DRG ;select drug
  1.  S PSORX("EDIT")=1,RX0HLD=RX0
  1.  S PSODRUG("IEN")=$S($G(PSODRUG("IEN"))]"":PSODRUG("IEN"),1:$P(RX0,"^",6)),PSODRUG("NAME")=$S($G(PSODRUG("NAME"))]"":PSODRUG("NAME"),1:$P(^PSDRUG($P(RX0,"^",6),0),"^"))
  1.  D ^PSODRG I PSODRUG("IEN")=$P(RX0,"^",6) K PSORXED("FLD",6)
  1.  D:PSODRUG("IEN")'=$P(RX0,"^",6)  I $G(PSORX("DFLG")) K PSORXED("FLD",6) S PSORXED("DFLG")=1 Q
  1.  .S ^TMP("PSORXBO",$J,RX0,0)=1
  1.  .D POST^PSODRG
  1.  .I '$O(^PSRX(PSORXED("IRXN"),1,0)) S PSORXED("FLD",17)=$G(PSODRUG("COST"))
  1.  .I $G(PSORX("DFLG")) K PSORXED("FLD",6),PSODRUG,PSOOIFLG,PSOSIGFL,VALMSG Q
  1.  .N PSOXXX  ;*422
  1.  .S PSOXXX(1)="You have changed the dispense drug from",PSOXXX(2)=$P(^PSDRUG($P(PSORXED("RX0"),"^",6),0),"^")_" to "_$P(^PSDRUG(PSODRUG("IEN"),0),"^")_"." D EN^DDIOL(.PSOXXX,"","!") S PSOAC=1  ;*422
  1.  .S PSOREEDQ=1 D DOLST^PSOORED3,DOSE^PSOORED3 K PSOREEDQ
  1.  .I '$O(PSORXED("DOSE",0)) S PSORX("DFLG")=1 Q
  1.  .;I $P($G(PSORXED("RX0")),U,11)="P",PSODRUG("DEA")["D",+$G(PSOFRPK)'=1 D
  1.  .;.N DIR,PRKMW D MW^PSOPRK S PSOFRPK=1,PSORXED("MAIL/WINDOW")=PRKMW ;PAPI 441
  1.  .D:$G(PSOSIGFL) M2
  1.  S RX0=RX0HLD K RX0HLD I $G(PSODRUG("OI"))=$G(PSOI) D  Q
  1.  .D:$O(^TMP("PSORXDC",$J,0))
  1.  ..W !!,"This edit will discontinue the duplicate Rx & change the dispensed drug!"
  1.  ..K DIR,X,Y S DIR("A")="Do You Want to Proceed",DIR("B")="NO",DIR(0)="Y"
  1.  ..D ^DIR K DIR S:'Y!($D(DIRUT)) PSORXED("DFLG")=1 D:Y DCORD^PSONEW2
  1.  .Q:$G(PSORXED("DFLG"))
  1.  .I PSODRUG("IEN")'=$P(RX0,"^",6) D
  1.  ..S PSORXED("FLD",6)=PSODRUG("IEN"),PSORXED("FLD",39.2)=PSOI
  1.  .S:$G(PSODRUG("TRADE NAME"))]"" PSORXED("FLD",6.5)=PSODRUG("TRADE NAME")
  1.  .S:$G(PSODRUG("NDC"))]"" PSORXED("FLD",27)=PSODRUG("NDC")
  1.  .S:$G(PSODRUG("DAW"))]"" PSORXED("FLD",81)=PSODRUG("DAW")
  1.  W !!,"New Orderable Item selected. This edit will create a new prescription!",! D PAUSE^VALM1 S VALMSG="New Orderable Item selected. This edit will create a new prescription!" S (PSOOIFLG,PSOSIGFL)=1
  1.  Q
  1. PSOCOU ;patient counseling
  1.  K DIC,DIQ S DIC=52,DA=PSORXED("IRXN"),DIQ="PSORXED",DR=41 D EN^DIQ1 K DIC,DIQ
  1.  D KV S DIR(0)="52,41" S:$G(PSORXED(52,DA,DR))]"" DIR("B")=PSORXED(52,DA,DR) D ^DIR K DIR,PSORXED(52,DA,DR)
  1.  I $D(DIRUT) K PSORXED("FLD",41) D KV Q
  1.  S PSORXED("FLD",DR)=Y D  K DIRUT
  1.  .I Y D  Q
  1.  ..K DIC,DIQ S DIC=52,DA=PSORXED("IRXN"),DIQ="PSORXED",DR=42 D EN^DIQ1 K DIC,DIQ
  1.  ..K DIR,DIRUT S DIR(0)="52,42" S:$G(PSORXED(52,DA,DR))]"" DIR("B")=PSORXED(52,DA,DR) D ^DIR K DIR,PSORXED(52,DA,DR)
  1.  ..I $D(DIRUT) K PSORXED("FLD",41),DUOUT,DTOUT Q
  1.  ..S PSORXED("FLD",42)=Y
  1.  .S PSORXED("FLD",41)=0,PSORXED("FLD",42)="@"
  1.  Q
  1. PSOI ;select orderable item
  1.  W !!,"Current Orderable Item: "_$P(^PS(50.7,PSOI,0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
  1.  S DIC("B")=$P(^PS(50.7,PSOI,0),"^"),DIC="^PS(50.7,",DIC(0)="AEMQZ"
  1.  S DIC("S")="I '$P(^PS(50.7,+Y,0),""^"",4)!($P(^(0),""^"",4)'<DT) N PSOF,PSOL S (PSOF,PSOL)=0 F  S PSOL=$O(^PSDRUG(""ASP"",+Y,PSOL)) Q:PSOF!'PSOL  "
  1.  S DIC("S")=DIC("S")_"I $P($G(^PSDRUG(PSOL,2)),U,3)[""O"",'$G(^(""I""))!($G(^(""I""))'<DT) S PSOF=1"
  1.  S D="B^C" D MIX^DIC1 I "^"[X S PSORXED("DFLG")=1 Q
  1.  G:Y<1 PSOI Q:PSOI=+Y
  1.  S PSODRUG("OI")=+Y,PSODRUG("OIN")=Y(0,0) K DIC
  1.  I PSOI'=PSODRUG("OI") W !!,"New Orderable Item selected. This edit will create a new prescription!",! D  K PSHOLDD Q
  1.  .N PSODDCHK S PSODDCHK=0  ;*422 - DUP DRUG CHECK ALREADY DONE IF SET TO 1
  1.  .D PAUSE^VALM1 I ($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) S PSORX("DFLG")=1 D M1 Q
  1.  .D M2
  1.  .S PSHOLDD=$G(PSODRUG("IEN")) K PSODRUG("IEN"),PSODRUG("NAME") S PSODRUG("DEA")="",(PSOOIFLG,PSOSIGFL)=1
  1.  .D DREN^PSOORNW2
  1.  .I $G(PSHOLDD),$G(PSODRUG("IEN")),$G(PSHOLDD)'=$G(PSODRUG("IEN")) D  Q:$G(PSORX("DFLG"))
  1.  ..I $G(PSORX("DFLG")) K PSODRUG S PSODRUG("IEN")=$G(PSHOLDD),PSODRUG("NAME")=$P($G(^PSDRUG(PSODRUG("IEN"),0)),"^") K PSOOIFLG,PSOSIGFL S VALMSG=""
  1.  .I '$G(PSODRUG("IEN")) W !!,"DRUG NAME REQUIRED!" D 2^PSOORNW1 S PSODDCHK=1  ;*422
  1.  .I '$G(PSODRUG("IEN")) K PSORXED("FLD"),INDEL,^TMP($J,"INS1"),PSOSIGFL,VALMSG S PSORXED("DFLG")=1,VALMSG="Dispense Drug NOT Selected!" Q
  1.  .D FULL^VALM1 D:'$G(PSODDCHK) POST^PSODRG S VALMBCK="R"  ;*422 ADDED PSODDCHK CHECK
  1.  .I PSORX("DFLG") K PSORXED("FLD"),INDEL,^TMP($J,"INS1"),PSOSIGFL,VALMSG Q
  1.  .N PSOXXX  ;*422
  1.  .S PSOXXX(1)="You have changed the Orderable Item from"
  1.  .S PSOXXX(2)=$P(^PS(50.7,PSOI,0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,PSOI,0),"^",2),0),"^")_" to "_PSODRUG("OIN")_" "_$P(^PS(50.606,$P(^PS(50.7,PSODRUG("OI"),0),"^",2),0),"^") D EN^DDIOL(.PSOXXX,"","!")  ;*422
  1.  .S PSOREEDQ=1 D DOLST^PSOORED3,DOSE^PSOORED3 K PSOREEDQ
  1.  .I '$O(PSORXED("DOSE",0)) S PSORX("DFLG")=1 Q
  1.  .D:$G(PSOSIGFL) M2
  1.  S PSORXED("FLD",39.2)=PSOI
  1.  Q
  1. NCPDP ;Reverse previously billed Rx on an edited orderable item or drug.
  1.  N RX,NPSOY
  1.  S RX=$G(PSORXED("IRXN")) I RX="" D
  1.  . S NPSOY=$O(PSONEW("OLD LAST RX#","")),NPSOY=$G(PSONEW("OLD LAST RX#",NPSOY)),RX=$O(^PSRX("B",NPSOY,RX))
  1.  I 'RX Q
  1.  D REVERSE^PSOBPSU1(RX,,"DC",7) S NCPDPFLG=0
  1.  Q
  1. UPDATE ;add new data to file
  1.  N RXREF,UPDATE,FLDS,CHGNDC,FLDTPRE
  1.  Q:'$G(PSORXED("IRXN"))
  1.  I $O(PSORXED("FLD",0))!($G(^TMP($J,"INS1",0))]"")!($G(INSDEL))!($O(PSORXED("ODOSE",0))) D  G:'Y UPDX
  1.  .K DIR,DIRUT,DTOUT,DUOUT
  1.  .S DIR(0)="Y",DIR("A")="Are You Sure You Want to Update Rx "_$P(^PSRX(PSORXED("IRXN"),0),"^"),DIR("B")="Yes"
  1.  .D ^DIR K DIR I 'Y D M1 Q
  1.  .I $D(^PSRX(PSORXED("IRXN"),1,0))  D
  1.  ..S RXREF=$P(^PSRX(PSORXED("IRXN"),0),"^",9)-$P(^PSRX(PSORXED("IRXN"),1,0),"^",4)
  1.  .E  S RXREF=0
  1.  .K X,DIRUT,DUOUT,DTOUT
  1.  I $D(PSORXED("FLD",39.3)) D UPDATE^PSODIAG  ;update ICD's after edit
  1.  ; - Retrieving fields before changes that are relevant for 3rd Party Billing
  1.  D GETS^DIQ(52,PSORXED("IRXN")_",","4;7;8;20;22;27;81","I","FLDS")
  1.  K Y S DA=PSORXED("IRXN"),DIE="^PSRX(",FLD=0
  1.  F  S FLD=$O(PSORXED("FLD",FLD)) Q:'FLD  D
  1.  .I FLD=12!(FLD=24)!(FLD=35) D  Q
  1.  ..I FLD=12,PSORXED("FLD",12)="@" S $P(^PSRX(DA,3),"^",7)="" Q
  1.  ..I FLD=12,PSORXED("FLD",12)]"" S $P(^PSRX(DA,3),"^",7)=PSORXED("FLD",12) Q
  1.  ..I FLD=24,PSORXED("FLD",24)="@" S $P(^PSRX(DA,2),"^",4)="" Q
  1.  ..I FLD=24,PSORXED("FLD",24)]"" S $P(^PSRX(DA,2),"^",4)=PSORXED("FLD",24) Q
  1.  ..I FLD=35,PSORXED("FLD",35)="@" S $P(^PSRX(DA,"MP"),"^")="" Q
  1.  ..I FLD=35,PSORXED("FLD",35)]"" S $P(^PSRX(DA,"MP"),"^")=PSORXED("FLD",35) Q
  1.  .I FLD=114!(FLD=128)!(FLD=129) D  Q  ;*441-IND
  1.  ..I $G(PSORXED("FLD",114))="" K ^PSRX(DA,"INS"),^PSRX(DA,"INS1"),^PSRX(DA,"INSS") ;*422
  1.  ..I $G(PSORXED("FLD",114))]"" D
  1.  ...S ^PSRX(DA,"INS")=PSORXED("FLD",114)
  1.  ...S X=PSORXED("FLD",114) D SIG^PSOHELP Q:$G(INS1)']""
  1.  ...S PSORXED("SIG",1)=$E(INS1,2,9999999) K ^PSRX(DA,"INS1")
  1.  ...S ^PSRX(DA,"INS1",0)="^52.0115^1^1^"_DT_"^^"
  1.  ...S ^PSRX(DA,"INS1",1,0)=PSORXED("SIG",1)
  1.  ..I $D(PSORXED("FLD",128)) S $P(^PSRX(DA,"IND"),"^")=PSORXED("FLD",128) K PSORXED("FLD",128) ;*441-IND
  1.  ..I $D(PSORXED("FLD",129)) S $P(^PSRX(DA,"IND"),"^",2)=PSORXED("FLD",129) K PSORXED("FLD",129)
  1.  ..I $D(PSORXED("FLD",130)) S $P(^PSRX(DA,"IND"),"^",3)=PSORXED("FLD",130) K PSORXED("FLD",130)
  1.  ..D DOLST^PSOORED3 D EN^PSOFSIG(.PSORXED),UPDSIG^PSOORED3
  1.  .I FLD=27 D  Q
  1.  ..I PSORXED("FLD",27)'=$$GETNDC^PSONDCUT(DA,0) D
  1.  ...S CHGNDC=1
  1.  ...D RXACT^PSOBPSU2(DA,0,"NDC changed from "_$$GETNDC^PSONDCUT(DA,0)_" to "_PSORXED("FLD",27)_".","E")
  1.  ..D SAVNDC^PSONDCUT(DA,0,PSORXED("FLD",27),0,1)
  1.  .I FLD=81 D SAVDAW^PSODAWUT(DA,0,PSORXED("FLD",81)) Q
  1.  .I FLD=100.2 D  Q  ;p753
  1.  ..N PSOMAIL,PSOMAILF
  1.  ..S PSOMAILF=$$GET1^DIQ(52,DA,100.2)
  1.  ..S DR=FLD_"////"_PSORXED("FLD",FLD) D ^DIE
  1.  ..S PSOMAIL=$$GET1^DIQ(52,DA,100.2)
  1.  ..I PSOMAILF']"" D RXACT^PSOBPSU2(DA,,"Mail Exemption changed to "_PSOMAIL_".","E") Q
  1.  ..I PSOMAIL]"" D RXACT^PSOBPSU2(DA,,"Mail Exemption changed from "_PSOMAILF_" to "_PSOMAIL_".","E") Q
  1.  ..I PSOMAIL']"" D RXACT^PSOBPSU2(DA,,"Mail Exemption "_PSOMAILF_" deleted.","E") Q
  1.  .;
  1.  .; Get FILL DATE before user prompt.
  1.  .S FLDTPRE=$$GET1^DIQ(52,PSORXED("IRXN"),22,"I")
  1.  .S DR=FLD_"////"_PSORXED("FLD",FLD)
  1.  .D ^DIE
  1.  .; If FILL DATE was edited, conditionally clear out the Suspense Hold Date.
  1.  .I FLDTPRE'=$$GET1^DIQ(52,PSORXED("IRXN"),22,"I") D CLRSHD^PSOBPSU4(PSORXED("IRXN"),0)
  1.  .;
  1.  .I +DR=11 D   ;441 PAPI
  1.  ..I $G(PSORXED("IRXN")),$G(^PSRX(PSORXED("IRXN"),"STA"))=1 Q
  1.  ..I $G(PSOFRPK) S PSDA=DA,SAVFLD=FLD D UNPARK^PSOPRK S FLD=SAVFLD K SAVFLD S DA=PSORXED("IRXN")
  1.  ..I $G(PSOTOPK) D PRK^PSOPRK(DA)
  1.  .I FLD=4 D UDPROV^PSOOREDT Q
  1.  ;
  1.  ; - Re-submitting Rx to ECME due to edits
  1.  D RESUB^PSOORED7
  1.  ;
  1.  I $G(INSDEL) K ^PSRX(DA,"INS"),^PSRX(DA,"INS1") D DOLST^PSOORED3 K PSORXED("SIG") D EN^PSOFSIG(.PSORXED),UPDSIG^PSOORED3 G UPDX
  1.  I $O(^TMP($J,"INS1",0)) D
  1.  .K ^PSRX(DA,"INS"),^PSRX(DA,"INS1"),DD,PSORXED("SIG")
  1.  .F I=0:0 S I=$O(^TMP($J,"INS1",I)) Q:'I  S (PSORXED("SIG",I),^PSRX(DA,"INS1",I,0))=^TMP($J,"INS1",I,0),DD=$G(DD)+1
  1.  .S ^PSRX(DA,"INS1",0)=^TMP($J,"INS1",0)
  1.  .I DD=1 S ^PSRX(DA,"INS")=^PSRX(DA,"INS1",1,0)
  1.  .D DOLST^PSOORED3,EN^PSOFSIG(.PSORXED),UPDSIG^PSOORED3
  1.  ; PSO*7.0*574
  1.  I $$ISCLOZ^PSJCLOZ(,,,,$G(PSODRUG("IEN"))) D EXPDT^PSOCLO1(.PSORXED,.CLOZPAT)
  1. UPDX ;
  1.  K DIE,DA,DR,FLD,X,Y,PSORXED("FLD"),DD,^TMP($J,"INS1")
  1. KV K DIR,DIRUT,DTOUT,DUOUT
  1.  Q
  1. UPD ;updates dosing array
  1.  S HENT=ENT
  1. UPD1 ;
  1.  I $G(PSORXED("CONJUNCTION",(HENT+1)))]"" S PSORXED("CONJUNCTION",HENT)=PSORXED("CONJUNCTION",(HENT+1)) D  G UPD
  1.  .K PSORXED("CONJUNCTION",(HENT+1))
  1.  .I $D(PSORXED("DOSE",(HENT+2))) D
  1.  ..S PSORXED("DOSE",(HENT+1))=PSORXED("DOSE",(HENT+2))
  1.  ..S PSORXED("ODOSE",(HENT+1))=$G(PSORXED("ODOSE",(HENT+2)))
  1.  ..S PSORXED("DOSE ORDERED",(HENT+1))=$G(PSORXED("DOSE ORDERED",(HENT+2)))
  1.  ..S PSORXED("UNITS",(HENT+1))=$G(PSORXED("UNITS",(HENT+2)))
  1.  ..S PSORXED("NOUN",(HENT+1))=$G(PSORXED("NOUN",(HENT+2)))
  1.  ..S PSORXED("DURATION",(HENT+1))=$G(PSORXED("DURATION",(HENT+2)))
  1.  ..S PSORXED("CONJUNCTION",(HENT+1))=$G(PSORXED("CONJUNCTION",(HENT+2)))
  1.  ..S PSORXED("ROUTE",(HENT+1))=$G(PSORXED("ROUTE",(HENT+2)))
  1.  ..S PSORXED("SCHEDULE",(HENT+1))=$G(PSORXED("SCHEDULE",(HENT+2)))
  1.  ..S PSORXED("VERB",(HENT+1))=$G(PSORXED("VERB",(HENT+2)))
  1.  ..K PSORXED("DOSE",(HENT+2)),PSORXED("ODOSE",(HENT+2)),PSORXED("DOSE ORDERED",(HENT+2))
  1.  ..K PSORXED("UNITS",(HENT+2)),PSORXED("NOUN",(HENT+2)),PSORXED("DURATION",(HENT+2)),PSORXED("ROUTE",(HENT+2)),PSORXED("SCHEDULE",(HENT+2)),PSORXED("VERB",(HENT+2))
  1.  .S HENT=HENT+1
  1.  F I=0:0 S I=$O(PSORXED("DOSE",I)) Q:'I  S SENT=$G(SENT)+1
  1.  Q
  1.  ;
  1. M1 D M1^PSOOREDX
  1.  Q
  1. M2 D M2^PSOOREDX
  1.  Q