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

PSOORNE4.m

Go to the documentation of this file.
  1. PSOORNE4 ;BIR/SAB-display renew RXs from backdoor ;Mar 30, 2022@14:37:15
  1. ;;7.0;OUTPATIENT PHARMACY;**11,27,32,36,46,75,96,103,99,117,131,225,386,390,391,313,411,661,441,700,743,746,769**;DEC 1997;Build 26
  1. ;^SC DBIA-10040;^PS(50.7-2223;^PS(50.606-2174;^PS(50.607-2221;^PS(51.2-2226;^PSDRUG-221;^PS(55-2228
  1. ;External reference to EN1^ORCFLAG supported by DBIA 3620
  1. ;External reference to ^DD("DD" supported by DBIA 999
  1. ;External reference to ^PS(50.606 supported by DBIA 2174
  1. ;External reference to ^PS(50.7 supported by DBIA 2223
  1. ;External reference to ^PS(51.2 supported by DBIA 2226
  1. ;
  1. EN(PSONEW) N FLD,LST,VALMCNT,ERXIEN,PSOVLMBG
  1. EN1 K PSOQUIT D:$G(PSONEW("ENT"))'>0 I $G(PSORENW("POE"))=1 S PSOREEDT=1 D SV
  1. .S PSOREEDT=1 D SV
  1. .K PSONEW("DOSE"),PSONEW("UNITS"),PSONEW("DOSE ORDERED"),PSONEW("ROUTE")
  1. .K PSONEW("SCHEDULE"),PSONEW("DURATION"),PSONEW("CONJUNCTION"),PSONEW("NOUN"),PSONEW("VERB"),PSOPRC,PSONEW("ODOSE")
  1. RDD D DSPL,^PSOLMRN D:$G(PKI1)=2 DCP^PSOPKIV1 I $G(PSORX("FN")) S VALMBCK="Q" K PSOREEDT Q
  1. G:'$G(PSOQUIT) RDD
  1. Q
  1. EDT D KV^PSOVER1 S DIR("A")="Select Field to Edit by number",DIR(0)="LO^1:"_$S($G(PSOREEDT):10,1:8)
  1. D ^DIR I $D(DTOUT)!($D(DUOUT)) D KV^PSOVER1 S VALMBCK="" Q
  1. EDTSEL S PSOLM=1,(PSONEW("DFLG"),PSONEW("FIELD"),PSONEW3)=0
  1. K PSOVLMBG I '$G(PSORXIEN),$G(ORD),$$ERXIEN^PSOERXUT($G(ORD)_"P") S PSOVLMBG=VALMBG
  1. I +Y S LST=Y D HLDHDR^PSOLMUTL S PSOEDT=1 D Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
  1. .F FLD=1:1:$L(LST,",") Q:$P(LST,",",FLD)']"" D @(+$P(LST,",",FLD)) Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
  1. E S VALMBCK="" D FULL^VALM1
  1. Q
  1. ACP ; Renewal Accept
  1. N DIR,Y,DIRUT,DUOUT,DTOUT,DIR S Y=0
  1. I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 D Q:$D(DIRUT)!'Y D EN1^ORCFLAG(+$P($G(^PS(52.41,ORD,0)),"^")) H 1
  1. . D FULL^VALM1
  1. . I '$D(^XUSEC("PSORPH",DUZ)) D S Y=0 Q
  1. . . S DIR("A",1)="Order must be unflagged by a pharmacist before it can be finished."
  1. . . S DIR("A",2)=""
  1. . . S DIR(0)="E",DIR("A")="Enter RETURN to continue" W !,$C(7) D ^DIR
  1. . . S VALMBCK="R"
  1. . D FULL^VALM1
  1. . S DIR("A",1)="This Order is flagged. In order to finish it"
  1. . S DIR("A",2)="you must unflag it first."
  1. . S DIR("A",3)=""
  1. . S DIR(0)="Y",DIR("A")="Unflag Order",DIR("B")="NO"
  1. . W ! D ^DIR I $D(DIRUT)!'Y S VALMBCK="Q"
  1. I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 Q
  1. ;
  1. D INST2^PSORENW S PSOFROM1=1 D:$D(^XUSEC("PSORPH",DUZ))!('$P(PSOPAR,"^",2)) VER
  1. K PSOFROM1
  1. PKI I $G(PSONEW("QFLG")) S POERR("DFLG")=1,VALMBCK="R" K PSONEW2 Q
  1. I PSONEW("ENT")>0,$G(NEWDOSE) K NEWDOSE G EN1 Q
  1. S PSORX("FN")=1 D EN^PSORN52(.PSONEW) D:$G(PKI)=89802020 ALERT^PSOPKIV1
  1. S ZFRENEW=1
  1. ;saves drug allergy order chks pso*7*390
  1. I $D(^TMP("PSODAOC",$J)),'$G(PSORNALL) D
  1. .I $G(PSORX("DFLG")) K ^TMP("PSODAOC",$J) Q
  1. .S RXN=PSORENW("IRXN") D DAOC^PSONEW
  1. I $G(PSORNALL),$D(^TMP("PSODAOC",$J)) S PSORNEDT=$O(^TMP("PSORXN",$J,0))
  1. K ZFRENEW
  1. D RNPSOSD^PSOUTIL,ACP1^PSOORNE6,^PSOBUILD S VALMBCK="Q"
  1. W !!!,"...ORDER RENEWED.",!!! ;P661
  1. Q
  1. VER1(PSONEW) ;
  1. VER S (PSONEW("DFLG"),PSONEW("QFLG"))=0 I PSONEW("ENT")=0 D K PSOORRNW,PSOFROM1 I PSONEW("DFLG")=1 S (PSONEW("QFLG"),POERR("DFLG"))=1 Q
  1. .S (PSOREEDT,PSOORRNW)=1 W !!,"Dosing Instruction Missing!!",!
  1. .S PSONEW("IRXN")=PSONEW("OIRXN") K VALMSG D FULL^VALM1 W !,"Drug: "_PSODRUG("NAME") D
  1. ..I $O(SIG(0)) D Q
  1. ...N I F I=1:1 Q:$G(SIG(I))']"" W !,SIG(I)
  1. ..I $P($G(^PSRX(PSONEW("OIRXN"),"SIG")),"^")]"" S X=$P(^PSRX(PSONEW("OIRXN"),"SIG"),"^") D SIGONE^PSOHELP W !,$E($G(INS1),2,250)
  1. .K DIRUT W ! D DOSE^PSODIR(.PSONEW) Q:$G(PSONEW("DFLG")) D EN^PSOFSIG(.PSONEW)
  1. .I PSONEW("ENT")>0,$O(SIG(0)) S (SIGOK,NEWDOSE)=1
  1. .I '$G(SPEED),PSONEW("DFLG")=1 S VALMSG="Renewal Request Cancelled!" W:$G(SPEED) !,"Renewal Request Cancelled!" Q:$G(PSONEW("DFLG"))
  1. .I +$G(PSONEW("ENT"))'>0 K DIRUT Q
  1. .D INS^PSODIR(.PSONEW),EN^PSOFSIG(.PSONEW),SINS^PSODIR(.PSONEW):$G(^PS(55,PSODFN,"LAN"))
  1. .S:'$G(SPEED)&(PSONEW("DFLG")=1) VALMSG="Renewal Request Cancelled!" W:$G(SPEED)&(PSONEW("DFLG")=1) !,"Renewal Request Cancelled!"
  1. .I $G(SPEED),'$G(PSONEW("DFLG")) D KV^PSOVER1 S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR,KV^PSOVER1 K X,Y
  1. I +$G(PSONEW("ENT"))'>0 G VER
  1. D STOP^PSORENW1 I +$G(PSEXDT) D S PSORENW("QFLG")=1
  1. .S Y=PSORENW("FILL DATE") X ^DD("DD") S VALMSG=Y_" fill date is past expiration date "
  1. .S Y=$P(PSEXDT,"^",2) X ^DD("DD") S VALMSG=VALMSG_Y_"."
  1. Q
  1. DSPL G:$G(PSONEW("ENT"))>0 DSP
  1. S PSONEW("ENT")=0 N I F I=0:0 S I=$O(^PSRX(PSONEW("OIRXN"),6,I)) Q:'I S DOSE=^PSRX(PSONEW("OIRXN"),6,I,0) D
  1. .S PSONEW("ENT")=PSONEW("ENT")+1,PSONEW("DOSE",PSONEW("ENT"))=$P(DOSE,"^")
  1. .S PSONEW("UNITS",PSONEW("ENT"))=$P(DOSE,"^",3),PSONEW("DOSE ORDERED",PSONEW("ENT"))=$P(DOSE,"^",2),PSONEW("ROUTE",PSONEW("ENT"))=$P(DOSE,"^",7)
  1. .S PSONEW("SCHEDULE",PSONEW("ENT"))=$P(DOSE,"^",8),PSONEW("DURATION",PSONEW("ENT"))=$P(DOSE,"^",5),PSONEW("CONJUNCTION",PSONEW("ENT"))=$P(DOSE,"^",6)
  1. .S PSONEW("NOUN",PSONEW("ENT"))=$P(DOSE,"^",4),PSONEW("VERB",PSONEW("ENT"))=$P(DOSE,"^",9)
  1. .I $G(^PSRX(PSONEW("OIRXN"),6,I,1))]"" S PSONEW("ODOSE",PSONEW("ENT"))=^PSRX(PSONEW("OIRXN"),6,I,1)
  1. .K DOSE
  1. DSP D ^PSOORUT2 K ^TMP("PSOPO",$J) S IEN=0
  1. D:$G(PSONEW("PENDING ORDER")) LMDISP^PSOORFI5(+PSONEW("PENDING ORDER"))
  1. I $G(PKI1)!($G(PKI)=1) D L1^PSOPKIV1 K:$G(PKI)=1 PKI
  1. D DIN^PSONFI(PSODRUG("OI"),$S($G(PSODRUG("IEN")):PSODRUG("IEN"),1:""))
  1. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Rx#: "_PSONEW("NRX #")
  1. I +$G(PSODRUG("OI")) D
  1. .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Orderable Item: "_$P(^PS(50.7,+$G(PSODRUG("OI")),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_NFIO
  1. .S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
  1. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" "_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID
  1. S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
  1. S:$G(PSONEW("TN"))]"" IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Trade Name: "_$G(PSONEW("TN"))
  1. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Patient Status: "_$P(PSONEW("PTST NODE"),"^"),PSONEW("PATIENT STATUS")=$P(PSONEW("PTST NODE"),"^")
  1. S (PSOID,Y)=PSONEW("ISSUE DATE") X ^DD("DD") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (1) Issue Date: "_Y
  1. S Y=PSONEW("FILL DATE") X ^DD("DD") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Fill Date: "_Y
  1. I PSONEW("ENT")=0 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT):" (9)",1:" ")_" Dosage:" G PAT
  1. N I F I=1:1:PSONEW("ENT") D
  1. .I '$G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I))
  1. .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT)&(I'>1):" (9)",1:" ")_" Dosage: "_$S($E(PSONEW("DOSE",I),1)="."&($G(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I)
  1. .S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_$S($G(PSONEW("UNITS",I))]"":" ("_$P(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",1:"")
  1. .I $P($G(^PS(55,PSODFN,"LAN")),"^"),'$G(PSONEW("DOSE ORDERED",I)) D
  1. ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Oth. Lang. Dosage: "_$G(PSONEW("ODOSE",I))
  1. .I $G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" D
  1. ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I))
  1. ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Dispense Units: "_$S($E($G(PSONEW("DOSE ORDERED",I)),1)=".":"0",1:"")_$G(PSONEW("DOSE ORDERED",I))
  1. ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Noun: "_$G(PSONEW("NOUN",I))
  1. .I $G(PSONEW("ROUTE",I)) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Route: "_$P(^PS(51.2,PSONEW("ROUTE",I),0),"^")
  1. .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Schedule: "_PSONEW("SCHEDULE",I)
  1. .I $G(PSONEW("DURATION",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" *Duration: "_$G(PSONEW("DURATION",I))
  1. .I $G(PSONEW("CONJUNCTION",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Conjunction: "_$S($G(PSONEW("CONJUNCTION",I))="A":"AND",$G(PSONEW("CONJUNCTION",I))="T":"THEN",$G(PSONEW("CONJUNCTION",I))="X":"EXCEPT",1:"")
  1. PAT S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT):" (10)",1:" ")_"Pat Instruction:" D INS2^PSOBKDED
  1. S RXN=PSONEW("OIRXN") D INST1^PSORENW
  1. ;I $O(PRC(0)) D PC1^PSOORNE5
  1. K RXN N I,SG S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:"
  1. I $G(SIGOK),$O(SIG(0)) D K SG,MIG
  1. .F I=0:0 S I=$O(SIG(I)) Q:'I F SG=1:1:$L(SIG(I)) D
  1. ..S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG(I)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" "
  1. ..S:$P(SIG(I)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG(I)," ",SG)
  1. E D
  1. .S X=$S($G(PSONEW("SIG"))]"":PSONEW("SIG"),1:$P($G(^PSRX(PSONEW("OIRXN"),"SIG")),"^")) D SIGONE^PSOHELP S SIG=$E($G(INS1),2,250)
  1. .F SG=1:1:$L(SIG) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG," ",SG)
  1. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Days Supply: "_PSONEW("DAYS SUPPLY")_$S($L(PSONEW("DAYS SUPPLY"))=1:" ",1:"")
  1. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" QTY"_$S($G(PSODRUG("UNIT"))]"":" ("_PSODRUG("UNIT")_")",1:" ( )")_": "_PSONEW("QTY")
  1. I $D(^PSDRUG("AQ",PSODRUG("IEN"))),$P($G(^PSDRUG(PSODRUG("IEN"),5)),"^")]"" D
  1. .S $P(RN," ",79)=" ",IEN=IEN+1
  1. .S ^TMP("PSOPO",$J,IEN,0)=" QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^")
  1. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (3) # of Refills: "_PSONEW("# OF REFILLS")_$S($L(PSONEW("# OF REFILLS"))=1:" ",1:"")
  1. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4) Routing: "_$S($G(PSORENW("MAIL/WINDOW"))["W":"WINDOW",$E($G(PSORENW("MAIL/WINDOW")))="P":"PARK",1:"MAIL") ;441 PAPI
  1. S:$G(PSONEW("METHOD OF PICK-UP"))]""&($P(PSOPAR,"^",12)) IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Method of Pickup: "_PSONEW("METHOD OF PICK-UP")
  1. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Clinic: "_$S($G(PSONEW("CLINIC")):$P(^SC(PSONEW("CLINIC"),0),"^"),1:"")
  1. S $P(RN," ",31)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Provider: "_PSONEW("PROVIDER NAME")_$E(RN,$L(PSONEW("PROVIDER NAME"))+1,31) K RN
  1. I $G(PSODRUG("DEA")),+PSODRUG("DEA")>1,+PSODRUG("DEA")<6 D PRV^PSOORFI5($G(PSORENW("PROVIDER")),$G(PSODRUG("IEN")),$P($G(OR0),"^"))
  1. I $G(PSONEW("COSIGNING PROVIDER"))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")
  1. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (7) Copies: "_$S($G(PSONEW("COPIES")):PSONEW("COPIES"),1:1)
  1. RMK S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8) Remarks: "_$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"")
  1. S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,DUZ,0),"^")_$E(RN,$L($P(^VA(200,DUZ,0),"^"))+1,35)
  1. I $G(PSOFDR) S ^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,$P(OR0,"^",4),0),"^")_$E(RN,$L($P(^VA(200,$P(OR0,"^",4),0),"^"))+1,35)
  1. D NOW^%DTC S PSONEW("LOGIN DATE")=$S($P($G(OR0),"^",6):$P($G(OR0),"^",6),1:%) K %,X S Y=PSONEW("LOGIN DATE") X ^DD("DD")
  1. S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"Entry Date: "_$P(Y,"@")_" "_$P(Y,"@",2) K RN
  1. S (VALMCNT,PSOPF)=IEN
  1. ; eRx Pending Order (Side-By-Side) Interface (Replaces conventional interface above) (PSORXIEN indicates a manual renewal from Backdoor)
  1. S ERXIEN=0 I '$G(PSORXIEN),$G(ORD) S ERXIEN=$$ERXIEN^PSOERXUT(ORD_"P")
  1. I ERXIEN D
  1. . N SUGFLDT,LASTRX,Y
  1. . S SUGFLDT=$$SUGFLDT^PSOERUT(ORD),LASTRX=0
  1. . I $D(^XUSEC("PSO ERX P746 TEMP KEY",DUZ)),'$G(FDEDITED),SUGFLDT>DT D
  1. . . S (PSONEW("FILL DATE"),Y)=$P(SUGFLDT,"^"),LASTRX=+$P(SUGFLDT,"^",2) X ^DD("DD") S PSORX("FILL DATE")=Y
  1. . S (IEN,LINE)=0 K ^TMP("PSOPO",$J)
  1. . D SETPEN^PSOERUT5("PSOPO",ERXIEN,+ORD,.PSONEW,.PSODRUG,.SIG,1,LASTRX) S (VALMCNT,PSOPF,IEN)=LINE-1
  1. . D RV^PSONFI
  1. I $G(PSOFDR) D:$P(OR0,"^",24)
  1. .K PSOCSP S PSOCSP("NAME")=$G(PSODRUG("NAME")) M PSOCSP("DOSE")=PSONEW("DOSE"),PSOCSP("DOSE ORDERED")=PSONEW("DOSE ORDERED")
  1. .S PSOCSP("# OF REFILLS")=PSONEW("# OF REFILLS") ;track original data for dig. orders
  1. .S PSOCSP("ISSUE DATE")=$E($P(OR0,"^",6),1,7),PSOCSP("QTY")=PSONEW("QTY"),PSOCSP("DAYS SUPPLY")=PSONEW("DAYS SUPPLY")
  1. Q
  1. 1 D 1^PSOBKDED Q
  1. 2 D 2^PSOBKDED Q
  1. 3 I $P($G(OR0),"^",24) D Q
  1. . W !!,"Digitally Signed Order - Refills cannot be changed",! D PZ
  1. D 9^PSOBKDED Q
  1. 4 D 12^PSOBKDED Q
  1. 5 D 5^PSOBKDED Q
  1. 6 I $P($G(OR0),"^",24) D Q
  1. . W !!,"Digitally Signed Order - Provider cannot be changed",! D PZ
  1. D 4^PSOBKDED Q
  1. 7 D 11^PSOBKDED Q
  1. 8 D 13^PSOBKDED Q
  1. 9 W !!,"Drug: "_PSODRUG("NAME") S PSOORRNW=1 D DOSE1^PSOORED5(.PSONEW)
  1. I $G(PSONEW("DFLG")) S PSODIR("DFLG")=1,VALMBCK="Q" Q
  1. D SV Q
  1. 10 D INS^PSODIR(.PSONEW),SINS^PSODIR(.PSONEW) D SV Q
  1. SV D SV^PSOORNE5 Q
  1. ;
  1. PZ ;
  1. N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
  1. Q