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

PSORENW3.m

Go to the documentation of this file.
  1. PSORENW3 ;IHS/DSD/JCM - EDIT TEMPLATE FOR RENEW RX ORDER ENTRY ;Dec 22, 2021@07:12:33
  1. ;;7.0;OUTPATIENT PHARMACY;**11,20,46,100,117,444,440,514,441**;DEC 1997;Build 208
  1. ;External reference to ^PSDRUG supported by DBIA 221
  1. ;External reference to ^SC supported by DBIA 10040
  1. ;
  1. START ;
  1. D INIT
  1. ;
  1. 1 S PSORENW("FLD")=1 D ISSDT^PSODIR2(.PSORENW) ; Get Issue Date
  1. G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
  1. ;
  1. 2 S PSORENW("FLD")=2 D FILLDT^PSODIR2(.PSORENW) ; Get Fill date
  1. G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
  1. ;
  1. 3 S PSORENW("FLD")=3 D PROV^PSODIR(.PSORENW) ; Get Provider
  1. G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
  1. ;
  1. 4 S PSORENW("FLD")=4,PSORENW("DAYS SUPPLY")=$P(PSORENW("RX0"),"^",8)
  1. K PSORENW("# OF REFILLS") D REFILL^PSODIR1(.PSORENW) ; Get # of refills
  1. G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
  1. ;
  1. 5 S PSORENW("FLD")=5 D RMK^PSODIR2(.PSORENW) ; Get Remarks
  1. G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
  1. ;
  1. 6 S PSORENW("FLD")=6 D MW^PSODIR2(.PSORENW) ; Get Mail/Window Info
  1. G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
  1. ;
  1. 7 I $G(DUZ("AG"))="I" S PSORENW("FLD")=7 D EXP^PSODIR2(.PSORENW) ; Get Expiration Date - Indian Health Service ONLY
  1. G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
  1. ;
  1. 8 I $G(DUZ("AG"))="I" S PSORENW("FLD")=8 D CLERK^PSODIR2(.PSORENW) ; Get Clerk Code
  1. G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
  1. ;
  1. 9 S PSORENW("FLD")=9 D CLINIC^PSODIR2(.PSORENW)
  1. G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
  1. ;
  1. END ;
  1. K PSORENW3 S PSORENW("EDIT")=1
  1. Q
  1. ;
  1. INIT ;
  1. S:'$G(PSORENW("QTY")) PSORENW("QTY")=$P(PSORENW("RX0"),"^",7)
  1. S:'$G(PSORENW("DAYS SUPPLY")) PSORENW("DAYS SUPPLY")=$P(PSORENW("RX0"),"^",8)
  1. S (PSORENW("DFLG"),PSORENW("FIELD"),PSORENW3)=0
  1. G:$G(PSORENW("EDIT")) INITX
  1. S PSORENW("ISSUE DATE")=$S($P($G(OR0),"^",3)="RNW":$E($P($G(OR0),"^",6),1,7),DT>PSORENW("FILL DATE"):PSORENW("FILL DATE"),1:DT) ;;PSO*440
  1. S PSORENW("CLINIC")=$P(PSORENW("RX0"),"^",5)
  1. I $G(PSOFDR),$P($G(OR0),"^",13) S PSORENW("CLINIC")=$P($G(OR0),"^",13)
  1. S:PSORENW("CLINIC") PSORX("CLINIC")=$P(^SC(PSORENW("CLINIC"),0),"^")
  1. S Y=PSORENW("FILL DATE") X ^DD("DD") S PSORX("FILL DATE")=Y K Y
  1. S PSORENW("PROVIDER")=$S($G(PSORENW("PROVIDER")):PSORENW("PROVIDER"),1:$P(PSORENW("RX0"),"^",4))
  1. S PSORENW("PROVIDER NAME")=$P($G(^VA(200,PSORENW("PROVIDER"),0)),"^")
  1. S PSORENW("PTST NODE")=$G(^PS(53,$P(PSORENW("RX0"),"^",3),0))
  1. S PSORENW("# OF REFILLS")=$S($G(PSORENW("# OF REFILLS")):PSORENW("# OF REFILLS"),1:$P(PSORENW("RX0"),"^",9))
  1. S PSORENW("REMARKS")="RENEWED FROM RX # "_$P(PSORENW("RX0"),"^")
  1. ;S PSORX("MAIL/WINDOW")=$S($G(PSORX("MAIL/WINDOW"))]"":PSORX("MAIL/WINDOW"),$P(PSORENW("RX0"),"^",11)="W":"WINDOW",1:"MAIL")
  1. S PSORX("MAIL/WINDOW")=$S($G(PSORX("MAIL/WINDOW"))]"":PSORX("MAIL/WINDOW"),$P(PSORENW("RX0"),"^",11)="W":"WINDOW",$P(PSORENW("RX0"),"^",11)="P":"PARK",1:"MAIL") ;PAPI 441
  1. S:$G(PSORX("CLERK CODE"))']"" PSORX("CLERK CODE")=$P($G(^VA(200,DUZ,0)),"^")
  1. S PSORENW("INS")=$S($G(PSORENW("INS"))]"":PSORENW("INS"),1:$G(^PSRX(PSORENW("OIRXN"),"INS")))
  1. ;441-IND
  1. S PSORENW("IND")=$S($G(PSORENW("IND"))]"":PSORENW("IND"),1:$P($G(^PSRX(PSORENW("OIRXN"),"IND")),"^"))
  1. S PSORENW("INDF")=$S($G(PSORENW("INDF"))]"":PSORENW("INDF"),1:$P($G(^PSRX(PSORENW("OIRXN"),"IND")),"^",2))
  1. S:$P($G(^PS(55,PSODFN,"LAN")),"^") PSORENW("INDO")=$S($G(PSORENW("INDO"))]"":PSORENW("INDO"),1:$P($G(^PSRX(PSORENW("OIRXN"),"IND")),"^",3))
  1. F D=0:0 S D=$O(^PSRX(PSORENW("OIRXN"),"INS1",D)) Q:'D S PSORENW("SIG",D)=^PSRX(PSORENW("OIRXN"),"INS1",D,0)
  1. I '$O(PSORENW("DOSE",0)) F I=0:0 S I=$O(^PSRX(PSORENW("OIRXN"),6,I)) Q:'I S DOSE=^PSRX(PSORENW("OIRXN"),6,I,0) D
  1. .S PSORENW("ENT")=$G(PSORENW("ENT"))+1,PSORENW("DOSE",PSORENW("ENT"))=$P(DOSE,"^")
  1. .S PSORENW("UNITS",PSORENW("ENT"))=$P(DOSE,"^",3),PSORENW("DOSE ORDERED",PSORENW("ENT"))=$P(DOSE,"^",2),PSORENW("ROUTE",PSORENW("ENT"))=$P(DOSE,"^",7)
  1. .S PSORENW("SCHEDULE",PSORENW("ENT"))=$P(DOSE,"^",8),PSORENW("DURATION",PSORENW("ENT"))=$P(DOSE,"^",5),PSORENW("CONJUNCTION",PSORENW("ENT"))=$P(DOSE,"^",6)
  1. .S PSORENW("NOUN",PSORENW("ENT"))=$P(DOSE,"^",4),PSORENW("VERB",PSORENW("ENT"))=$P(DOSE,"^",9)
  1. .I $G(^PSRX(PSORENW("OIRXN"),6,I,1))]"" S PSORENW("ODOSE",PSORENW("ENT"))=^PSRX(PSORENW("OIRXN"),6,I,1)
  1. .K DOSE
  1. ;for titration renewal, rebuild SIG - *p441
  1. I $$TITRX^PSOUTL(PSORENW("OIRXN"))="t",$G(PSOORRNW) D
  1. .S SIGOK=1
  1. .D EN^PSOFSIG(.PSORENW)
  1. .I '$O(SIG(0)),$G(ORD) F I=0:0 S I=$O(^PS(52.41,ORD,"SIG",I)) Q:'I S SIG(I)=^PS(52.41,ORD,"SIG",I,0)
  1. .I '$O(SIG(0)) S SIG(1)="This Prescription is MISSING Required Medication Instructions for the Patient. Please Review Dosaging Instructions."
  1. I $P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^",2),'$O(SIG(0)) S SIGOK=1 D Q
  1. .F I=0:0 S I=$O(^PSRX(PSORENW("OIRXN"),"SIG1",I)) Q:'I S SIG(I)=^PSRX(PSORENW("OIRXN"),"SIG1",I,0)
  1. .I '$O(SIG(0)),$G(ORD),$G(PSOORRNW) F I=0:0 S I=$O(^PS(52.41,ORD,"SIG",I)) Q:'I S SIG(I)=^PS(52.41,ORD,"SIG",I,0)
  1. .I '$O(SIG(0)) S SIG(1)="This Prescription is MISSING Required Medication Instructions for the Patient. Please Review Dosaging Instructions."
  1. I $P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^")]"",'$P(^("SIG"),"^",2),'$O(SIG(0)) S SIGOK=1 D
  1. .S X=$P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^") D SIG^PSOHELP I $G(INS1)]"" S SIG(1)=$E(INS1,2,999)
  1. .I '$O(SIG(0)) S (PSORENW("SIG"),SIG(1))="This Prescription is MISSING Required Usable Medication Instructions for the Patient. Please Review Dosaging Instructions."
  1. INITX Q
  1. JUMP ;
  1. S PSORENW("FIELD")=$S(+Y=1:1,+Y=22:2,+Y=4:3,+Y=5:9,+Y=9:4,+Y=12:5,+Y=11:6,+Y=29:7,+Y=16:8,1:PSORENW("FLD"))
  1. Q
  1. DSPLY ;called from PSORENW0
  1. S:'$G(DFN) DFN=+$G(PSORENW("PSODFN")) ;514
  1. W !!,PSORENW("NRX #"),?12," ",$P(^PSDRUG(PSORENW("DRUG IEN"),0),"^"),?46," QTY: ",$S($G(PSORENW("QTY")):PSORENW("QTY"),1:$P(PSORENW("RX0"),"^",7))
  1. W !,"# OF REFILLS: "_$S($G(PSORENW("# OF REFILLS")):PSORENW("# OF REFILLS"),1:$P(PSORENW("RX0"),"^",9))
  1. W " ISSUED: "_$S(DT>PSORENW("FILL DATE"):$E(PSORENW("FILL DATE"),4,5)_"-"_$E(PSORENW("FILL DATE"),6,7)_"-"_$E(PSORENW("FILL DATE"),2,3),1:$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3))
  1. F DR=1:1:PSORENW("ENT") I $G(PSORENW("DURATION",DR))]"" D
  1. .S DUR1=PSORENW("DURATION",DR)
  1. .S PSORENW("DURATION",DR)=$S($E(DUR1,1)'?.N:$E(DUR1,2,99)_$E(DUR1,1),1:DUR1)
  1. F D=0:0 S D=$O(^PSRX(PSORENW("OIRXN"),"INS1",D)) Q:'D S PSORENW("SIG",D)=^PSRX(PSORENW("OIRXN"),"INS1",D,0)
  1. K DR,DUR1 ;D EN^PSOFSIG(.PSORENW)
  1. I $G(SIGOK) D:'$O(SIG(0)) W !,"SIG: " F D=0:0 Q:'$O(SIG(D)) S D=$O(SIG(D)) W SIG(D),!
  1. .F I=0:0 S I=$O(^PSRX(PSORENW("OIRXN"),"SIG1",I)) Q:'I S SIG(I)=^PSRX(PSORENW("OIRXN"),"SIG1",I,0)
  1. .I '$O(SIG(0)) S SIG(1)="This Prescription is MISSING Required Usable Medication Instructions",SIG(2)="for the Patient. Please Review Dosaging Instructions.",PSORENW("DFLG")=1
  1. E W " SIG: "_PSORENW("SIG")_" "
  1. W "FILLED: "_$E(PSORENW("FILL DATE"),4,5)_"-"_$E(PSORENW("FILL DATE"),6,7)_"-"_$E(PSORENW("FILL DATE"),2,3)
  1. ;W !,"ROUTING: "_$S($G(PSORENW("MAIL/WINDOW"))["W":"WINDOW",1:"MAIL")
  1. W !,"ROUTING: "_$S($G(PSORENW("MAIL/WINDOW"))["W":"WINDOW",$E($G(PSORENW("MAIL/WINDOW")))="P":"PARK",1:"MAIL") ;PAPI 441
  1. W " PHYS: "_PSORX("PROVIDER NAME"),!
  1. I $G(PSORENW("DFLG")),'$G(SPEED) K DIR S DIR(0)="E",DIR("A")="Rx NOT Renewed. Press Return to Continue" D ^DIR K DIR,DIRUT,DTOUT,DUOUT
  1. DSPLYX Q