- PSORENW3 ;IHS/DSD/JCM - EDIT TEMPLATE FOR RENEW RX ORDER ENTRY ;Dec 22, 2021@07:12:33
- ;;7.0;OUTPATIENT PHARMACY;**11,20,46,100,117,444,440,514,441**;DEC 1997;Build 208
- ;External reference to ^PSDRUG supported by DBIA 221
- ;External reference to ^SC supported by DBIA 10040
- ;
- START ;
- D INIT
- ;
- 1 S PSORENW("FLD")=1 D ISSDT^PSODIR2(.PSORENW) ; Get Issue Date
- G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
- ;
- 2 S PSORENW("FLD")=2 D FILLDT^PSODIR2(.PSORENW) ; Get Fill date
- G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
- ;
- 3 S PSORENW("FLD")=3 D PROV^PSODIR(.PSORENW) ; Get Provider
- G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
- ;
- 4 S PSORENW("FLD")=4,PSORENW("DAYS SUPPLY")=$P(PSORENW("RX0"),"^",8)
- K PSORENW("# OF REFILLS") D REFILL^PSODIR1(.PSORENW) ; Get # of refills
- G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
- ;
- 5 S PSORENW("FLD")=5 D RMK^PSODIR2(.PSORENW) ; Get Remarks
- G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
- ;
- 6 S PSORENW("FLD")=6 D MW^PSODIR2(.PSORENW) ; Get Mail/Window Info
- G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
- ;
- 7 I $G(DUZ("AG"))="I" S PSORENW("FLD")=7 D EXP^PSODIR2(.PSORENW) ; Get Expiration Date - Indian Health Service ONLY
- G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
- ;
- 8 I $G(DUZ("AG"))="I" S PSORENW("FLD")=8 D CLERK^PSODIR2(.PSORENW) ; Get Clerk Code
- G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
- ;
- 9 S PSORENW("FLD")=9 D CLINIC^PSODIR2(.PSORENW)
- G:PSORENW("DFLG") END G:PSORENW("FIELD") @PSORENW("FIELD")
- ;
- END ;
- K PSORENW3 S PSORENW("EDIT")=1
- Q
- ;
- INIT ;
- S:'$G(PSORENW("QTY")) PSORENW("QTY")=$P(PSORENW("RX0"),"^",7)
- S:'$G(PSORENW("DAYS SUPPLY")) PSORENW("DAYS SUPPLY")=$P(PSORENW("RX0"),"^",8)
- S (PSORENW("DFLG"),PSORENW("FIELD"),PSORENW3)=0
- G:$G(PSORENW("EDIT")) INITX
- 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
- S PSORENW("CLINIC")=$P(PSORENW("RX0"),"^",5)
- I $G(PSOFDR),$P($G(OR0),"^",13) S PSORENW("CLINIC")=$P($G(OR0),"^",13)
- S:PSORENW("CLINIC") PSORX("CLINIC")=$P(^SC(PSORENW("CLINIC"),0),"^")
- S Y=PSORENW("FILL DATE") X ^DD("DD") S PSORX("FILL DATE")=Y K Y
- S PSORENW("PROVIDER")=$S($G(PSORENW("PROVIDER")):PSORENW("PROVIDER"),1:$P(PSORENW("RX0"),"^",4))
- S PSORENW("PROVIDER NAME")=$P($G(^VA(200,PSORENW("PROVIDER"),0)),"^")
- S PSORENW("PTST NODE")=$G(^PS(53,$P(PSORENW("RX0"),"^",3),0))
- S PSORENW("# OF REFILLS")=$S($G(PSORENW("# OF REFILLS")):PSORENW("# OF REFILLS"),1:$P(PSORENW("RX0"),"^",9))
- S PSORENW("REMARKS")="RENEWED FROM RX # "_$P(PSORENW("RX0"),"^")
- ;S PSORX("MAIL/WINDOW")=$S($G(PSORX("MAIL/WINDOW"))]"":PSORX("MAIL/WINDOW"),$P(PSORENW("RX0"),"^",11)="W":"WINDOW",1:"MAIL")
- 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
- S:$G(PSORX("CLERK CODE"))']"" PSORX("CLERK CODE")=$P($G(^VA(200,DUZ,0)),"^")
- S PSORENW("INS")=$S($G(PSORENW("INS"))]"":PSORENW("INS"),1:$G(^PSRX(PSORENW("OIRXN"),"INS")))
- ;441-IND
- S PSORENW("IND")=$S($G(PSORENW("IND"))]"":PSORENW("IND"),1:$P($G(^PSRX(PSORENW("OIRXN"),"IND")),"^"))
- S PSORENW("INDF")=$S($G(PSORENW("INDF"))]"":PSORENW("INDF"),1:$P($G(^PSRX(PSORENW("OIRXN"),"IND")),"^",2))
- S:$P($G(^PS(55,PSODFN,"LAN")),"^") PSORENW("INDO")=$S($G(PSORENW("INDO"))]"":PSORENW("INDO"),1:$P($G(^PSRX(PSORENW("OIRXN"),"IND")),"^",3))
- F D=0:0 S D=$O(^PSRX(PSORENW("OIRXN"),"INS1",D)) Q:'D S PSORENW("SIG",D)=^PSRX(PSORENW("OIRXN"),"INS1",D,0)
- 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
- .S PSORENW("ENT")=$G(PSORENW("ENT"))+1,PSORENW("DOSE",PSORENW("ENT"))=$P(DOSE,"^")
- .S PSORENW("UNITS",PSORENW("ENT"))=$P(DOSE,"^",3),PSORENW("DOSE ORDERED",PSORENW("ENT"))=$P(DOSE,"^",2),PSORENW("ROUTE",PSORENW("ENT"))=$P(DOSE,"^",7)
- .S PSORENW("SCHEDULE",PSORENW("ENT"))=$P(DOSE,"^",8),PSORENW("DURATION",PSORENW("ENT"))=$P(DOSE,"^",5),PSORENW("CONJUNCTION",PSORENW("ENT"))=$P(DOSE,"^",6)
- .S PSORENW("NOUN",PSORENW("ENT"))=$P(DOSE,"^",4),PSORENW("VERB",PSORENW("ENT"))=$P(DOSE,"^",9)
- .I $G(^PSRX(PSORENW("OIRXN"),6,I,1))]"" S PSORENW("ODOSE",PSORENW("ENT"))=^PSRX(PSORENW("OIRXN"),6,I,1)
- .K DOSE
- ;for titration renewal, rebuild SIG - *p441
- I $$TITRX^PSOUTL(PSORENW("OIRXN"))="t",$G(PSOORRNW) D
- .S SIGOK=1
- .D EN^PSOFSIG(.PSORENW)
- .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)
- .I '$O(SIG(0)) S SIG(1)="This Prescription is MISSING Required Medication Instructions for the Patient. Please Review Dosaging Instructions."
- I $P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^",2),'$O(SIG(0)) S SIGOK=1 D Q
- .F I=0:0 S I=$O(^PSRX(PSORENW("OIRXN"),"SIG1",I)) Q:'I S SIG(I)=^PSRX(PSORENW("OIRXN"),"SIG1",I,0)
- .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)
- .I '$O(SIG(0)) S SIG(1)="This Prescription is MISSING Required Medication Instructions for the Patient. Please Review Dosaging Instructions."
- I $P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^")]"",'$P(^("SIG"),"^",2),'$O(SIG(0)) S SIGOK=1 D
- .S X=$P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^") D SIG^PSOHELP I $G(INS1)]"" S SIG(1)=$E(INS1,2,999)
- .I '$O(SIG(0)) S (PSORENW("SIG"),SIG(1))="This Prescription is MISSING Required Usable Medication Instructions for the Patient. Please Review Dosaging Instructions."
- INITX Q
- JUMP ;
- 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"))
- Q
- DSPLY ;called from PSORENW0
- S:'$G(DFN) DFN=+$G(PSORENW("PSODFN")) ;514
- W !!,PSORENW("NRX #"),?12," ",$P(^PSDRUG(PSORENW("DRUG IEN"),0),"^"),?46," QTY: ",$S($G(PSORENW("QTY")):PSORENW("QTY"),1:$P(PSORENW("RX0"),"^",7))
- W !,"# OF REFILLS: "_$S($G(PSORENW("# OF REFILLS")):PSORENW("# OF REFILLS"),1:$P(PSORENW("RX0"),"^",9))
- 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))
- F DR=1:1:PSORENW("ENT") I $G(PSORENW("DURATION",DR))]"" D
- .S DUR1=PSORENW("DURATION",DR)
- .S PSORENW("DURATION",DR)=$S($E(DUR1,1)'?.N:$E(DUR1,2,99)_$E(DUR1,1),1:DUR1)
- F D=0:0 S D=$O(^PSRX(PSORENW("OIRXN"),"INS1",D)) Q:'D S PSORENW("SIG",D)=^PSRX(PSORENW("OIRXN"),"INS1",D,0)
- K DR,DUR1 ;D EN^PSOFSIG(.PSORENW)
- 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),!
- .F I=0:0 S I=$O(^PSRX(PSORENW("OIRXN"),"SIG1",I)) Q:'I S SIG(I)=^PSRX(PSORENW("OIRXN"),"SIG1",I,0)
- .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
- E W " SIG: "_PSORENW("SIG")_" "
- W "FILLED: "_$E(PSORENW("FILL DATE"),4,5)_"-"_$E(PSORENW("FILL DATE"),6,7)_"-"_$E(PSORENW("FILL DATE"),2,3)
- ;W !,"ROUTING: "_$S($G(PSORENW("MAIL/WINDOW"))["W":"WINDOW",1:"MAIL")
- W !,"ROUTING: "_$S($G(PSORENW("MAIL/WINDOW"))["W":"WINDOW",$E($G(PSORENW("MAIL/WINDOW")))="P":"PARK",1:"MAIL") ;PAPI 441
- W " PHYS: "_PSORX("PROVIDER NAME"),!
- 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
- DSPLYX Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORENW3 7431 printed Jan 18, 2025@03:34:56 Page 2
- 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
- +2 ;External reference to ^PSDRUG supported by DBIA 221
- +3 ;External reference to ^SC supported by DBIA 10040
- +4 ;
- START ;
- +1 DO INIT
- +2 ;
- 1 ; Get Issue Date
- SET PSORENW("FLD")=1
- DO ISSDT^PSODIR2(.PSORENW)
- +1 if PSORENW("DFLG")
- GOTO END
- if PSORENW("FIELD")
- GOTO @PSORENW("FIELD")
- +2 ;
- 2 ; Get Fill date
- SET PSORENW("FLD")=2
- DO FILLDT^PSODIR2(.PSORENW)
- +1 if PSORENW("DFLG")
- GOTO END
- if PSORENW("FIELD")
- GOTO @PSORENW("FIELD")
- +2 ;
- 3 ; Get Provider
- SET PSORENW("FLD")=3
- DO PROV^PSODIR(.PSORENW)
- +1 if PSORENW("DFLG")
- GOTO END
- if PSORENW("FIELD")
- GOTO @PSORENW("FIELD")
- +2 ;
- 4 SET PSORENW("FLD")=4
- SET PSORENW("DAYS SUPPLY")=$PIECE(PSORENW("RX0"),"^",8)
- +1 ; Get # of refills
- KILL PSORENW("# OF REFILLS")
- DO REFILL^PSODIR1(.PSORENW)
- +2 if PSORENW("DFLG")
- GOTO END
- if PSORENW("FIELD")
- GOTO @PSORENW("FIELD")
- +3 ;
- 5 ; Get Remarks
- SET PSORENW("FLD")=5
- DO RMK^PSODIR2(.PSORENW)
- +1 if PSORENW("DFLG")
- GOTO END
- if PSORENW("FIELD")
- GOTO @PSORENW("FIELD")
- +2 ;
- 6 ; Get Mail/Window Info
- SET PSORENW("FLD")=6
- DO MW^PSODIR2(.PSORENW)
- +1 if PSORENW("DFLG")
- GOTO END
- if PSORENW("FIELD")
- GOTO @PSORENW("FIELD")
- +2 ;
- 7 ; Get Expiration Date - Indian Health Service ONLY
- IF $GET(DUZ("AG"))="I"
- SET PSORENW("FLD")=7
- DO EXP^PSODIR2(.PSORENW)
- +1 if PSORENW("DFLG")
- GOTO END
- if PSORENW("FIELD")
- GOTO @PSORENW("FIELD")
- +2 ;
- 8 ; Get Clerk Code
- IF $GET(DUZ("AG"))="I"
- SET PSORENW("FLD")=8
- DO CLERK^PSODIR2(.PSORENW)
- +1 if PSORENW("DFLG")
- GOTO END
- if PSORENW("FIELD")
- GOTO @PSORENW("FIELD")
- +2 ;
- 9 SET PSORENW("FLD")=9
- DO CLINIC^PSODIR2(.PSORENW)
- +1 if PSORENW("DFLG")
- GOTO END
- if PSORENW("FIELD")
- GOTO @PSORENW("FIELD")
- +2 ;
- END ;
- +1 KILL PSORENW3
- SET PSORENW("EDIT")=1
- +2 QUIT
- +3 ;
- INIT ;
- +1 if '$GET(PSORENW("QTY"))
- SET PSORENW("QTY")=$PIECE(PSORENW("RX0"),"^",7)
- +2 if '$GET(PSORENW("DAYS SUPPLY"))
- SET PSORENW("DAYS SUPPLY")=$PIECE(PSORENW("RX0"),"^",8)
- +3 SET (PSORENW("DFLG"),PSORENW("FIELD"),PSORENW3)=0
- +4 if $GET(PSORENW("EDIT"))
- GOTO INITX
- +5 ;;PSO*440
- SET PSORENW("ISSUE DATE")=$SELECT($PIECE($GET(OR0),"^",3)="RNW":$EXTRACT($PIECE($GET(OR0),"^",6),1,7),DT>PSORENW("FILL DATE"):PSORENW("FILL DATE"),1:DT)
- +6 SET PSORENW("CLINIC")=$PIECE(PSORENW("RX0"),"^",5)
- +7 IF $GET(PSOFDR)
- IF $PIECE($GET(OR0),"^",13)
- SET PSORENW("CLINIC")=$PIECE($GET(OR0),"^",13)
- +8 if PSORENW("CLINIC")
- SET PSORX("CLINIC")=$PIECE(^SC(PSORENW("CLINIC"),0),"^")
- +9 SET Y=PSORENW("FILL DATE")
- XECUTE ^DD("DD")
- SET PSORX("FILL DATE")=Y
- KILL Y
- +10 SET PSORENW("PROVIDER")=$SELECT($GET(PSORENW("PROVIDER")):PSORENW("PROVIDER"),1:$PIECE(PSORENW("RX0"),"^",4))
- +11 SET PSORENW("PROVIDER NAME")=$PIECE($GET(^VA(200,PSORENW("PROVIDER"),0)),"^")
- +12 SET PSORENW("PTST NODE")=$GET(^PS(53,$PIECE(PSORENW("RX0"),"^",3),0))
- +13 SET PSORENW("# OF REFILLS")=$SELECT($GET(PSORENW("# OF REFILLS")):PSORENW("# OF REFILLS"),1:$PIECE(PSORENW("RX0"),"^",9))
- +14 SET PSORENW("REMARKS")="RENEWED FROM RX # "_$PIECE(PSORENW("RX0"),"^")
- +15 ;S PSORX("MAIL/WINDOW")=$S($G(PSORX("MAIL/WINDOW"))]"":PSORX("MAIL/WINDOW"),$P(PSORENW("RX0"),"^",11)="W":"WINDOW",1:"MAIL")
- +16 ;PAPI 441
- SET PSORX("MAIL/WINDOW")=$SELECT($GET(PSORX("MAIL/WINDOW"))]"":PSORX("MAIL/WINDOW"),$PIECE(PSORENW("RX0"),"^",11)="W":"WINDOW",$PIECE(PSORENW("RX0"),"^",11)="P":"PARK",1:"MAIL")
- +17 if $GET(PSORX("CLERK CODE"))']""
- SET PSORX("CLERK CODE")=$PIECE($GET(^VA(200,DUZ,0)),"^")
- +18 SET PSORENW("INS")=$SELECT($GET(PSORENW("INS"))]"":PSORENW("INS"),1:$GET(^PSRX(PSORENW("OIRXN"),"INS")))
- +19 ;441-IND
- +20 SET PSORENW("IND")=$SELECT($GET(PSORENW("IND"))]"":PSORENW("IND"),1:$PIECE($GET(^PSRX(PSORENW("OIRXN"),"IND")),"^"))
- +21 SET PSORENW("INDF")=$SELECT($GET(PSORENW("INDF"))]"":PSORENW("INDF"),1:$PIECE($GET(^PSRX(PSORENW("OIRXN"),"IND")),"^",2))
- +22 if $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
- SET PSORENW("INDO")=$SELECT($GET(PSORENW("INDO"))]"":PSORENW("INDO"),1:$PIECE($GET(^PSRX(PSORENW("OIRXN"),"IND")),"^",3))
- +23 FOR D=0:0
- SET D=$ORDER(^PSRX(PSORENW("OIRXN"),"INS1",D))
- if 'D
- QUIT
- SET PSORENW("SIG",D)=^PSRX(PSORENW("OIRXN"),"INS1",D,0)
- +24 IF '$ORDER(PSORENW("DOSE",0))
- FOR I=0:0
- SET I=$ORDER(^PSRX(PSORENW("OIRXN"),6,I))
- if 'I
- QUIT
- SET DOSE=^PSRX(PSORENW("OIRXN"),6,I,0)
- Begin DoDot:1
- +25 SET PSORENW("ENT")=$GET(PSORENW("ENT"))+1
- SET PSORENW("DOSE",PSORENW("ENT"))=$PIECE(DOSE,"^")
- +26 SET PSORENW("UNITS",PSORENW("ENT"))=$PIECE(DOSE,"^",3)
- SET PSORENW("DOSE ORDERED",PSORENW("ENT"))=$PIECE(DOSE,"^",2)
- SET PSORENW("ROUTE",PSORENW("ENT"))=$PIECE(DOSE,"^",7)
- +27 SET PSORENW("SCHEDULE",PSORENW("ENT"))=$PIECE(DOSE,"^",8)
- SET PSORENW("DURATION",PSORENW("ENT"))=$PIECE(DOSE,"^",5)
- SET PSORENW("CONJUNCTION",PSORENW("ENT"))=$PIECE(DOSE,"^",6)
- +28 SET PSORENW("NOUN",PSORENW("ENT"))=$PIECE(DOSE,"^",4)
- SET PSORENW("VERB",PSORENW("ENT"))=$PIECE(DOSE,"^",9)
- +29 IF $GET(^PSRX(PSORENW("OIRXN"),6,I,1))]""
- SET PSORENW("ODOSE",PSORENW("ENT"))=^PSRX(PSORENW("OIRXN"),6,I,1)
- +30 KILL DOSE
- End DoDot:1
- +31 ;for titration renewal, rebuild SIG - *p441
- +32 IF $$TITRX^PSOUTL(PSORENW("OIRXN"))="t"
- IF $GET(PSOORRNW)
- Begin DoDot:1
- +33 SET SIGOK=1
- +34 DO EN^PSOFSIG(.PSORENW)
- +35 IF '$ORDER(SIG(0))
- IF $GET(ORD)
- FOR I=0:0
- SET I=$ORDER(^PS(52.41,ORD,"SIG",I))
- if 'I
- QUIT
- SET SIG(I)=^PS(52.41,ORD,"SIG",I,0)
- +36 IF '$ORDER(SIG(0))
- SET SIG(1)="This Prescription is MISSING Required Medication Instructions for the Patient. Please Review Dosaging Instructions."
- End DoDot:1
- +37 IF $PIECE($GET(^PSRX(PSORENW("OIRXN"),"SIG")),"^",2)
- IF '$ORDER(SIG(0))
- SET SIGOK=1
- Begin DoDot:1
- +38 FOR I=0:0
- SET I=$ORDER(^PSRX(PSORENW("OIRXN"),"SIG1",I))
- if 'I
- QUIT
- SET SIG(I)=^PSRX(PSORENW("OIRXN"),"SIG1",I,0)
- +39 IF '$ORDER(SIG(0))
- IF $GET(ORD)
- IF $GET(PSOORRNW)
- FOR I=0:0
- SET I=$ORDER(^PS(52.41,ORD,"SIG",I))
- if 'I
- QUIT
- SET SIG(I)=^PS(52.41,ORD,"SIG",I,0)
- +40 IF '$ORDER(SIG(0))
- SET SIG(1)="This Prescription is MISSING Required Medication Instructions for the Patient. Please Review Dosaging Instructions."
- End DoDot:1
- QUIT
- +41 IF $PIECE($GET(^PSRX(PSORENW("OIRXN"),"SIG")),"^")]""
- IF '$PIECE(^("SIG"),"^",2)
- IF '$ORDER(SIG(0))
- SET SIGOK=1
- Begin DoDot:1
- +42 SET X=$PIECE($GET(^PSRX(PSORENW("OIRXN"),"SIG")),"^")
- DO SIG^PSOHELP
- IF $GET(INS1)]""
- SET SIG(1)=$EXTRACT(INS1,2,999)
- +43 IF '$ORDER(SIG(0))
- SET (PSORENW("SIG"),SIG(1))="This Prescription is MISSING Required Usable Medication Instructions for the Patient. Please Review Dosaging Instructions."
- End DoDot:1
- INITX QUIT
- JUMP ;
- +1 SET PSORENW("FIELD")=$SELECT(+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"))
- +2 QUIT
- DSPLY ;called from PSORENW0
- +1 ;514
- if '$GET(DFN)
- SET DFN=+$GET(PSORENW("PSODFN"))
- +2 WRITE !!,PSORENW("NRX #"),?12," ",$PIECE(^PSDRUG(PSORENW("DRUG IEN"),0),"^"),?46," QTY: ",$SELECT($GET(PSORENW("QTY")):PSORENW("QTY"),1:$PIECE(PSORENW("RX0"),"^",7))
- +3 WRITE !,"# OF REFILLS: "_$SELECT($GET(PSORENW("# OF REFILLS")):PSORENW("# OF REFILLS"),1:$PIECE(PSORENW("RX0"),"^",9))
- +4 WRITE " ISSUED: "_$SELECT(DT>PSORENW("FILL DATE"):$EXTRACT(PSORENW("FILL DATE"),4,5)_"-"_$EXTRACT(PSORENW("FILL DATE"),6,7)_"-"_$EXTRACT(PSORENW("FILL DATE"),2,3),1:$EXTRACT(DT,4,5)_"-"_$EXTRACT(DT,6,7)_"-"_$EXTRACT(DT,2,3))
- +5 FOR DR=1:1:PSORENW("ENT")
- IF $GET(PSORENW("DURATION",DR))]""
- Begin DoDot:1
- +6 SET DUR1=PSORENW("DURATION",DR)
- +7 SET PSORENW("DURATION",DR)=$SELECT($EXTRACT(DUR1,1)'?.N:$EXTRACT(DUR1,2,99)_$EXTRACT(DUR1,1),1:DUR1)
- End DoDot:1
- +8 FOR D=0:0
- SET D=$ORDER(^PSRX(PSORENW("OIRXN"),"INS1",D))
- if 'D
- QUIT
- SET PSORENW("SIG",D)=^PSRX(PSORENW("OIRXN"),"INS1",D,0)
- +9 ;D EN^PSOFSIG(.PSORENW)
- KILL DR,DUR1
- +10 IF $GET(SIGOK)
- if '$ORDER(SIG(0))
- Begin DoDot:1
- +11 FOR I=0:0
- SET I=$ORDER(^PSRX(PSORENW("OIRXN"),"SIG1",I))
- if 'I
- QUIT
- SET SIG(I)=^PSRX(PSORENW("OIRXN"),"SIG1",I,0)
- +12 IF '$ORDER(SIG(0))
- SET SIG(1)="This Prescription is MISSING Required Usable Medication Instructions"
- SET SIG(2)="for the Patient. Please Review Dosaging Instructions."
- SET PSORENW("DFLG")=1
- End DoDot:1
- WRITE !,"SIG: "
- FOR D=0:0
- if '$ORDER(SIG(D))
- QUIT
- SET D=$ORDER(SIG(D))
- WRITE SIG(D),!
- +13 IF '$TEST
- WRITE " SIG: "_PSORENW("SIG")_" "
- +14 WRITE "FILLED: "_$EXTRACT(PSORENW("FILL DATE"),4,5)_"-"_$EXTRACT(PSORENW("FILL DATE"),6,7)_"-"_$EXTRACT(PSORENW("FILL DATE"),2,3)
- +15 ;W !,"ROUTING: "_$S($G(PSORENW("MAIL/WINDOW"))["W":"WINDOW",1:"MAIL")
- +16 ;PAPI 441
- WRITE !,"ROUTING: "_$SELECT($GET(PSORENW("MAIL/WINDOW"))["W":"WINDOW",$EXTRACT($GET(PSORENW("MAIL/WINDOW")))="P":"PARK",1:"MAIL")
- +17 WRITE " PHYS: "_PSORX("PROVIDER NAME"),!
- +18 IF $GET(PSORENW("DFLG"))
- IF '$GET(SPEED)
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Rx NOT Renewed. Press Return to Continue"
- DO ^DIR
- KILL DIR,DIRUT,DTOUT,DUOUT
- DSPLYX QUIT