PSORENW1 ;BIR/DSD - Renew Main Driver Continuation ;06-Dec-2012 20:08;PLS
;;7.0;OUTPATIENT PHARMACY;**20,37,51,46,71,117,157,1003,1005,1013,143,219,239,225,1014,1015**;DEC 1997;Build 62
;External reference ^VA(200 supported by DBIA 10060
; Modified - IHS/CIA/PLS - 01/06/04 - Line START+5, OERR+6 and a new EP IHS
; 03/30/05 - Line IHS+4
; IHS/MSC/PLS - 02/13/12 - Line STOP+4
; 12/06/12 - Line FDR+10
START ;
S PSORENW("RX0")=^PSRX(PSORENW("OIRXN"),0),PSORENW("RX2")=^(2),PSORENW("RX3")=^(3),PSORENW("STA")=^("STA"),PSORENW("TN")=$G(^("TN")),SIGOK=+$P($G(^("SIG")),"^",2)
S PSOIBOLD=$G(PSORENW("OIRXN"))
D SETIB
S PSORENW("PROVIDER")=$P(PSORENW("RX0"),"^",4)
S PSORX("PROVIDER NAME")=$P($G(^VA(200,PSORENW("PROVIDER"),0)),"^")
D IHS ; Call to setup IHS nodes
S PSORENW("CLINIC")=$P(PSORENW("RX0"),"^",5),PSORENW("COPIES")=$P(PSORENW("RX0"),"^",18)
I $G(PSOFDR),$P($G(OR0),"^",13) S PSORENW("CLINIC")=$P($G(OR0),"^",13)
S PSORENW("REMARKS")="RENEWED FROM RX # "_$P(PSORENW("RX0"),"^")
S PSORENW("SIG")=$P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^")
S:$P(PSORENW("RX3"),"^",3) PSORENW("COSIGNING PROVIDER")=$P(PSORENW("RX3"),"^",3)
S (PSODFN,PSORENW("PSODFN"))=$P(PSORENW("RX0"),"^",2)
S PSORENW("ORX #")=$P(PSORENW("RX0"),"^")
S PSORENW("DRUG IEN")=$P(PSORENW("RX0"),"^",6)
S PSORENW("INS")=$S($G(PSORENW("INS"))]"":PSORENW("INS"),1:$G(^PSRX(PSORENW("OIRXN"),"INS")))
S D=0 F S D=$O(^PSRX(PSORENW("OIRXN"),"INS1",D)) Q:'D S PSORENW("SIG",D)=^PSRX(PSORENW("OIRXN"),"INS1",D,0)
I '$O(PSORENW("SIG",0)),$G(PSORENW("INS"))]"" S PSORENW("SIG",1)=PSORENW("INS")
G:$G(PSORENW("ENT")) FDR
I $G(PSORENW("ENT"))'>0,'$O(^PSRX(PSORENW("OIRXN"),6,0)) S PSORENW("ENT")=0 G FDR
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
FDR I $G(PSOFDR) D
.F I=0:0 S I=$O(^PSRX(PSORENW("OIRXN"),6,I)) Q:'I I $G(^PSRX(PSORENW("OIRXN"),6,I,1))]"" S PSORENW("ODOSE",I)=^PSRX(PSORENW("OIRXN"),6,I,1)
.S $P(PSORENW("RX0"),"^",7)=$P(OR0,"^",10),$P(PSORENW("RX0"),"^",11)=$P(OR0,"^",17)
.S (PSORX("PROVIDER NAME"),PSORENW("PROVIDER NAME"))=$P(^VA(200,$P(OR0,"^",5),0),"^"),PSORENW("PROVIDER")=$P(OR0,"^",5)
.K PSORENW("COSIGNING PROVIDER")
.I $G(PSORENW("PROVIDER")),$P($G(^VA(200,PSORENW("PROVIDER"),"PS")),"^",7),$P($G(^("PS")),"^",8) S PSORENW("COSIGNING PROVIDER")=$P($G(^("PS")),"^",8)
.S (PSDY,PSORENW("DAYS SUPPLY"))=$P(PSORENW("RX0"),"^",8)
.S POERR=1,DREN=$P(PSORENW("RX0"),"^",6) D DRG^PSOORDRG K POERR S PSODIR("CS")=0
.F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S PSODIR("CS")=1
.I PSODIR("CS") S RFMX=$S(PSDY<60:5,PSDY'<60&(PSDY'>89):2,PSDY=90:1,1:0)
.;IHS/MSC/PLS - 12/06/2012
.;E S RFMX=$S(PSDY<60:11,PSDY'<60&(PSDY'>89):5,PSDY=90:3,1:0)
.E S RFMX=$S(PSDY<60:15,PSDY<90:5,PSDY=90:3,PSDY<168:2,PSDY<365:1,1:0)
.S $P(PSORENW("RX0"),"^",9)=$S($P(OR0,"^",11)'>RFMX:$P(OR0,"^",11),1:RFMX),$P(OR0,"^",11)=$P(PSORENW("RX0"),"^",9)
.K RFMX,PSODIR("CS"),PSDY
END Q
STOP K PSEXDT,X,%DT S PSON52("QFLG")=0,DAYS=$S($G(PSORENW("DAYS SUPPLY")):PSORENW("DAYS SUPPLY"),1:$P(PSORENW("RX0"),"^",8))
S DEA("CS")=0 K DIR,DIC
F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S DEA("CS")=1
S X1=$S($G(PSORENW("ISSUE DATE")):$G(PSORENW("ISSUE DATE")),1:DT),X2=DAYS*($P(PSORENW("RX0"),"^",9)+1)\1
;IHS/MSC/PLS - 02/13/2012
;S X2=$S(DAYS=X2&('DEA("CS")):X2,DEA("CS"):184,1:366) D C^%DTC
S X2=$S(DEA("CS"):184,1:366) D C^%DTC
I PSORENW("FILL DATE")>$P(X,".") S PSEXDT=1_"^"_$P(X,".")
K X1,X2,X,%DT
Q
OERR ;renewal finish from oe/rr
S PSORENW("RX0")=^PSRX(PSORENW("OIRXN"),0),PSORENW("RX2")=^(2),PSORENW("RX3")=^(3),PSORENW("STA")=^("STA"),PSORENW("TN")=$G(^("TN"))
S $P(PSORENW("RX0"),"^",4)=$P(OR0,"^",5)
S PSORENW("PROVIDER")=$P(OR0,"^",5)
S PSORX("PROVIDER NAME")=$P($G(^VA(200,PSORENW("PROVIDER"),0)),"^")
S $P(PSORENW("RX0"),"^",5)=$P(OR0,"^",13)
D IHS ; IHS/CIA/PLS - 01/06/04 - Call to setup IHS nodes
S PSORENW("CLINIC")=$P(OR0,"^",13)
S PSORENW("REMARKS")="RENEWED FROM RX # "_$P(PSORENW("RX0"),"^")_"."_$S($P(OR0,"^",17)="C":" Administered in Clinic.",1:"")
S PSORENW("SIG")=$P($G(^PSRX(PSORENW("OIRXN"),"SIG")),"^"),SIGOK=$P(^("SIG"),"^",2) I SIGOK D
.F I=0:0 S I=$O(^PSRX(PSORENW("OIRXN"),"SIG1",I)) Q:'I S SIG(I)=^PSRX(PSORENW("OIRXN"),"SIG1",I,0)
S:$P(PSORENW("RX3"),"^",3) PSORENW("COSIGNING PROVIDER")=$P(PSORENW("RX3"),"^",3)
S PSORENW("PSODFN")=$P(PSORENW("RX0"),"^",2)
S PSORENW("ORX #")=$P(PSORENW("RX0"),"^")
S PSORENW("DRUG IEN")=$P(PSORENW("RX0"),"^",6),$P(PSORENW("RX0"),"^",11)=$P(OR0,"^",17)
S PSORENW("INS")=$S($G(PSORENW("INS"))]"":PSORENW("INS"),1:$G(^PSRX(PSORENW("OIRXN"),"INS")))
Q:$G(PSORENW("ENT"))>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")=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
Q
;
SETIB ;Set defaults on Renewals with Copay information
;If answer is in Pending File, use that, else look in Prescription file
N PSOOICD,JJJ
K PSOSCP,PSOANSQ("SC>50") D SCP^PSORN52D S PSOANSQ("SC>50")="" K PSOSCA
I '$G(PSOIBOLD) Q
I $G(PSOFDR),$G(ORD) D SETIBP Q
;I '$$DT^PSOMLLDT Q
I $G(PSORX(PSOIBOLD,"SC"))'=0,$G(PSORX(PSOIBOLD,"SC"))'=1 S PSORX(PSOIBOLD,"SC")=$S($P($G(^PSRX(PSOIBOLD,"IBQ")),"^")'="":$P($G(^("IBQ")),"^"),$P($G(^PSRX(PSOIBOLD,"IB")),"^"):0,1:"")
I $G(PSORX(PSOIBOLD,"SC"))="" K PSORX(PSOIBOLD,"SC")
I '$$DT^PSOMLLDT Q
I $G(PSORX(PSOIBOLD,"MST"))'=0,$G(PSORX(PSOIBOLD,"MST"))'=1,$P($G(^PSRX(PSOIBOLD,"IBQ")),"^",2)'="" S PSORX(PSOIBOLD,"MST")=$P($G(^("IBQ")),"^",2)
I $G(PSORX(PSOIBOLD,"VEH"))'=0,$G(PSORX(PSOIBOLD,"VEH"))'=1,$P($G(^PSRX(PSOIBOLD,"IBQ")),"^",3)'="" S PSORX(PSOIBOLD,"VEH")=$P($G(^("IBQ")),"^",3)
I $G(PSORX(PSOIBOLD,"RAD"))'=0,$G(PSORX(PSOIBOLD,"RAD"))'=1,$P($G(^PSRX(PSOIBOLD,"IBQ")),"^",4)'="" S PSORX(PSOIBOLD,"RAD")=$P($G(^("IBQ")),"^",4)
I $G(PSORX(PSOIBOLD,"PGW"))'=0,$G(PSORX(PSOIBOLD,"PGW"))'=1,$P($G(^PSRX(PSOIBOLD,"IBQ")),"^",5)'="" S PSORX(PSOIBOLD,"PGW")=$P($G(^("IBQ")),"^",5)
I $G(PSORX(PSOIBOLD,"HNC"))'=0,$G(PSORX(PSOIBOLD,"HNC"))'=1,$P($G(^PSRX(PSOIBOLD,"IBQ")),"^",6)'="" S PSORX(PSOIBOLD,"HNC")=$P($G(^("IBQ")),"^",6)
I $G(PSORX(PSOIBOLD,"CV"))'=0,$G(PSORX(PSOIBOLD,"CV"))'=1,$P($G(^PSRX(PSOIBOLD,"IBQ")),"^",7)'="" S PSORX(PSOIBOLD,"CV")=$P($G(^("IBQ")),"^",7)
I $G(PSORX(PSOIBOLD,"SHAD"))'=0,$G(PSORX(PSOIBOLD,"SHAD"))'=1,$P($G(^PSRX(PSOIBOLD,"IBQ")),"^",8)'="" S PSORX(PSOIBOLD,"SHAD")=$P($G(^("IBQ")),"^",8)
;
SET2 ;for when patient status is exempt or SC>50
I $TR($G(^PSRX(PSOIBOLD,"IBQ")),"^")="" S PSOOICD=$G(^PSRX(PSOIBOLD,"ICD",1,0)) D SET3:PSOOICD'=""
;
ICD I $D(^PSRX(PSORENW("OIRXN"),"ICD",0)) D
. N JJ,ICD,II,FLD,RXN S RXN=PSOIBOLD
. S II=0 F S II=$O(^PSRX(PSORENW("OIRXN"),"ICD",II)) Q:II=""!(II'?1N.N) D
.. S ICD=^PSRX(PSORENW("OIRXN"),"ICD",II,0),FLD=$P(ICD,U) D ICD^PSONEWF
Q
SET3 ;for when patient status is exempt or SC>50
D SET3^PSORN52D
Q
;
SETIBP ;
I $P($G(^PS(52.41,ORD,0)),"^",16)="SC"!($P($G(^(0)),"^",16)="NSC") S PSORX(PSOIBOLD,"SC")=$S($P($G(^(0)),"^",16)="SC":1,1:0)
I $G(PSORX(PSOIBOLD,"SC"))="" K PSORX(PSOIBOLD,"SC")
I '$$DT^PSOMLLDT Q
N PSOIBQFN S PSOIBQFN=$G(^PS(52.41,ORD,"IBQ"))
I $P(PSOIBQFN,"^",1)=0!($P(PSOIBQFN,"^",1)=1) S PSORX(PSOIBOLD,"MST")=$P(PSOIBQFN,"^")
I $P(PSOIBQFN,"^",2)=0!($P(PSOIBQFN,"^",2)=1) S PSORX(PSOIBOLD,"VEH")=$P(PSOIBQFN,"^",2)
I $P(PSOIBQFN,"^",3)=0!($P(PSOIBQFN,"^",3)=1) S PSORX(PSOIBOLD,"RAD")=$P(PSOIBQFN,"^",3)
I $P(PSOIBQFN,"^",4)=0!($P(PSOIBQFN,"^",4)=1) S PSORX(PSOIBOLD,"PGW")=$P(PSOIBQFN,"^",4)
I $P(PSOIBQFN,"^",5)=0!($P(PSOIBQFN,"^",5)=1) S PSORX(PSOIBOLD,"HNC")=$P(PSOIBQFN,"^",5)
I $P(PSOIBQFN,"^",6)=0!($P(PSOIBQFN,"^",6)=1) S PSORX(PSOIBOLD,"CV")=$P(PSOIBQFN,"^",6)
I $P(PSOIBQFN,"^",7)=0!($P(PSOIBQFN,"^",7)=1) S PSORX(PSOIBOLD,"SHAD")=$P(PSOIBQFN,"^",7)
;for when patient status is exempt, null IBQ node was set for exempts or SC>50 - data is in ICD node
I $TR($G(^PS(52.41,ORD,"IBQ")),"^")="" S PSOOICD=$G(^PS(52.41,ORD,"ICD",1,0)) D SET3:PSOOICD'=""
;
ICD2 ;
I $D(^PS(52.41,ORD,"ICD",0)) D
. N JJ,ICD,II,FLD,RXN S RXN=ORD
. S II=0 F S II=$O(^PS(52.41,ORD,"ICD",II)) Q:II=""!(II'?1N.N) D
.. S ICD="",ICD=^PS(52.41,ORD,"ICD",II,0)
.. I $G(PSOSCP)>49&(II=1) S PSORX(PSOIBOLD,"SC>50")=$P(ICD,"^",4)
.. S JJ="" F JJ=1:1:9 S FLD=$P(ICD,U,JJ) D ICD^PSONEWF
K PSOIBQFN
Q
KLIB ;Kill renewal IB array
I '$G(PSOIBOLD) Q
K PSORX(PSOIBOLD,"SC"),PSORX(PSOIBOLD,"MST"),PSORX(PSOIBOLD,"VEH"),PSORX(PSOIBOLD,"RAD"),PSORX(PSOIBOLD,"PGW"),PSORX(PSOIBOLD,"HNC"),PSORX(PSOIBOLD,"CV"),PSORX(PSOIBOLD,"SHAD")
K PSOIBOLD
Q
; IHS/CIA/PLS - 01/06/04
; API to set "PATIENT STATUS","QTY" and "ZCM" nodes
IHS ; EP
S PSORENW("QTY")=$P(PSORENW("RX0"),"^",7)
; IHS/CIA/PLS - 03/30/05 - Changed array name
;S PSORENW("ZCM")=$P($G(^PSRX(PSORENW("OIRXN"),9999999)),"^",2) ; Check Chronic Med in old script
S PSORENW("CM")=$P($G(^PSRX(PSORENW("OIRXN"),9999999)),"^",2) ; Check Chronic Med in old script
S:'$L($G(PSORENW("PATIENT STATUS"))) PSORENW("PATIENT STATUS")=$P(PSORENW("RX0"),"^",3)
Q
PSORENW1 ;BIR/DSD - Renew Main Driver Continuation ;06-Dec-2012 20:08;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**20,37,51,46,71,117,157,1003,1005,1013,143,219,239,225,1014,1015**;DEC 1997;Build 62
+2 ;External reference ^VA(200 supported by DBIA 10060
+3 ; Modified - IHS/CIA/PLS - 01/06/04 - Line START+5, OERR+6 and a new EP IHS
+4 ; 03/30/05 - Line IHS+4
+5 ; IHS/MSC/PLS - 02/13/12 - Line STOP+4
+6 ; 12/06/12 - Line FDR+10
START ;
+1 SET PSORENW("RX0")=^PSRX(PSORENW("OIRXN"),0)
SET PSORENW("RX2")=^(2)
SET PSORENW("RX3")=^(3)
SET PSORENW("STA")=^("STA")
SET PSORENW("TN")=$GET(^("TN"))
SET SIGOK=+$PIECE($GET(^("SIG")),"^",2)
+2 SET PSOIBOLD=$GET(PSORENW("OIRXN"))
+3 DO SETIB
+4 SET PSORENW("PROVIDER")=$PIECE(PSORENW("RX0"),"^",4)
+5 SET PSORX("PROVIDER NAME")=$PIECE($GET(^VA(200,PSORENW("PROVIDER"),0)),"^")
+6 ; Call to setup IHS nodes
DO IHS
+7 SET PSORENW("CLINIC")=$PIECE(PSORENW("RX0"),"^",5)
SET PSORENW("COPIES")=$PIECE(PSORENW("RX0"),"^",18)
+8 IF $GET(PSOFDR)
IF $PIECE($GET(OR0),"^",13)
SET PSORENW("CLINIC")=$PIECE($GET(OR0),"^",13)
+9 SET PSORENW("REMARKS")="RENEWED FROM RX # "_$PIECE(PSORENW("RX0"),"^")
+10 SET PSORENW("SIG")=$PIECE($GET(^PSRX(PSORENW("OIRXN"),"SIG")),"^")
+11 IF $PIECE(PSORENW("RX3"),"^",3)
SET PSORENW("COSIGNING PROVIDER")=$PIECE(PSORENW("RX3"),"^",3)
+12 SET (PSODFN,PSORENW("PSODFN"))=$PIECE(PSORENW("RX0"),"^",2)
+13 SET PSORENW("ORX #")=$PIECE(PSORENW("RX0"),"^")
+14 SET PSORENW("DRUG IEN")=$PIECE(PSORENW("RX0"),"^",6)
+15 SET PSORENW("INS")=$SELECT($GET(PSORENW("INS"))]"":PSORENW("INS"),1:$GET(^PSRX(PSORENW("OIRXN"),"INS")))
+16 SET D=0
FOR
SET D=$ORDER(^PSRX(PSORENW("OIRXN"),"INS1",D))
IF 'D
QUIT
SET PSORENW("SIG",D)=^PSRX(PSORENW("OIRXN"),"INS1",D,0)
+17 IF '$ORDER(PSORENW("SIG",0))
IF $GET(PSORENW("INS"))]""
SET PSORENW("SIG",1)=PSORENW("INS")
+18 IF $GET(PSORENW("ENT"))
GOTO FDR
+19 IF $GET(PSORENW("ENT"))'>0
IF '$ORDER(^PSRX(PSORENW("OIRXN"),6,0))
SET PSORENW("ENT")=0
GOTO FDR
+20 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
+21 SET PSORENW("ENT")=$GET(PSORENW("ENT"))+1
SET PSORENW("DOSE",PSORENW("ENT"))=$PIECE(DOSE,"^")
+22 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)
+23 SET PSORENW("SCHEDULE",PSORENW("ENT"))=$PIECE(DOSE,"^",8)
SET PSORENW("DURATION",PSORENW("ENT"))=$PIECE(DOSE,"^",5)
SET PSORENW("CONJUNCTION",PSORENW("ENT"))=$PIECE(DOSE,"^",6)
+24 SET PSORENW("NOUN",PSORENW("ENT"))=$PIECE(DOSE,"^",4)
SET PSORENW("VERB",PSORENW("ENT"))=$PIECE(DOSE,"^",9)
+25 IF $GET(^PSRX(PSORENW("OIRXN"),6,I,1))]""
SET PSORENW("ODOSE",PSORENW("ENT"))=^PSRX(PSORENW("OIRXN"),6,I,1)
+26 KILL DOSE
End DoDot:1
FDR IF $GET(PSOFDR)
Begin DoDot:1
+1 FOR I=0:0
SET I=$ORDER(^PSRX(PSORENW("OIRXN"),6,I))
IF 'I
QUIT
IF $GET(^PSRX(PSORENW("OIRXN"),6,I,1))]""
SET PSORENW("ODOSE",I)=^PSRX(PSORENW("OIRXN"),6,I,1)
+2 SET $PIECE(PSORENW("RX0"),"^",7)=$PIECE(OR0,"^",10)
SET $PIECE(PSORENW("RX0"),"^",11)=$PIECE(OR0,"^",17)
+3 SET (PSORX("PROVIDER NAME"),PSORENW("PROVIDER NAME"))=$PIECE(^VA(200,$PIECE(OR0,"^",5),0),"^")
SET PSORENW("PROVIDER")=$PIECE(OR0,"^",5)
+4 KILL PSORENW("COSIGNING PROVIDER")
+5 IF $GET(PSORENW("PROVIDER"))
IF $PIECE($GET(^VA(200,PSORENW("PROVIDER"),"PS")),"^",7)
IF $PIECE($GET(^("PS")),"^",8)
SET PSORENW("COSIGNING PROVIDER")=$PIECE($GET(^("PS")),"^",8)
+6 SET (PSDY,PSORENW("DAYS SUPPLY"))=$PIECE(PSORENW("RX0"),"^",8)
+7 SET POERR=1
SET DREN=$PIECE(PSORENW("RX0"),"^",6)
DO DRG^PSOORDRG
KILL POERR
SET PSODIR("CS")=0
+8 FOR DEA=1:1
IF $EXTRACT(PSODRUG("DEA"),DEA)=""
QUIT
IF $EXTRACT(+PSODRUG("DEA"),DEA)>1
IF $EXTRACT(+PSODRUG("DEA"),DEA)<6
SET PSODIR("CS")=1
+9 IF PSODIR("CS")
SET RFMX=$SELECT(PSDY<60:5,PSDY'<60&(PSDY'>89):2,PSDY=90:1,1:0)
+10 ;IHS/MSC/PLS - 12/06/2012
+11 ;E S RFMX=$S(PSDY<60:11,PSDY'<60&(PSDY'>89):5,PSDY=90:3,1:0)
+12 IF '$TEST
SET RFMX=$SELECT(PSDY<60:15,PSDY<90:5,PSDY=90:3,PSDY<168:2,PSDY<365:1,1:0)
+13 SET $PIECE(PSORENW("RX0"),"^",9)=$SELECT($PIECE(OR0,"^",11)'>RFMX:$PIECE(OR0,"^",11),1:RFMX)
SET $PIECE(OR0,"^",11)=$PIECE(PSORENW("RX0"),"^",9)
+14 KILL RFMX,PSODIR("CS"),PSDY
End DoDot:1
END QUIT
STOP KILL PSEXDT,X,%DT
SET PSON52("QFLG")=0
SET DAYS=$SELECT($GET(PSORENW("DAYS SUPPLY")):PSORENW("DAYS SUPPLY"),1:$PIECE(PSORENW("RX0"),"^",8))
+1 SET DEA("CS")=0
KILL DIR,DIC
+2 FOR DEA=1:1
IF $EXTRACT(PSODRUG("DEA"),DEA)=""
QUIT
IF $EXTRACT(+PSODRUG("DEA"),DEA)>1
IF $EXTRACT(+PSODRUG("DEA"),DEA)<6
SET DEA("CS")=1
+3 SET X1=$SELECT($GET(PSORENW("ISSUE DATE")):$GET(PSORENW("ISSUE DATE")),1:DT)
SET X2=DAYS*($PIECE(PSORENW("RX0"),"^",9)+1)\1
+4 ;IHS/MSC/PLS - 02/13/2012
+5 ;S X2=$S(DAYS=X2&('DEA("CS")):X2,DEA("CS"):184,1:366) D C^%DTC
+6 SET X2=$SELECT(DEA("CS"):184,1:366)
DO C^%DTC
+7 IF PSORENW("FILL DATE")>$PIECE(X,".")
SET PSEXDT=1_"^"_$PIECE(X,".")
+8 KILL X1,X2,X,%DT
+9 QUIT
OERR ;renewal finish from oe/rr
+1 SET PSORENW("RX0")=^PSRX(PSORENW("OIRXN"),0)
SET PSORENW("RX2")=^(2)
SET PSORENW("RX3")=^(3)
SET PSORENW("STA")=^("STA")
SET PSORENW("TN")=$GET(^("TN"))
+2 SET $PIECE(PSORENW("RX0"),"^",4)=$PIECE(OR0,"^",5)
+3 SET PSORENW("PROVIDER")=$PIECE(OR0,"^",5)
+4 SET PSORX("PROVIDER NAME")=$PIECE($GET(^VA(200,PSORENW("PROVIDER"),0)),"^")
+5 SET $PIECE(PSORENW("RX0"),"^",5)=$PIECE(OR0,"^",13)
+6 ; IHS/CIA/PLS - 01/06/04 - Call to setup IHS nodes
DO IHS
+7 SET PSORENW("CLINIC")=$PIECE(OR0,"^",13)
+8 SET PSORENW("REMARKS")="RENEWED FROM RX # "_$PIECE(PSORENW("RX0"),"^")_"."_$SELECT($PIECE(OR0,"^",17)="C":" Administered in Clinic.",1:"")
+9 SET PSORENW("SIG")=$PIECE($GET(^PSRX(PSORENW("OIRXN"),"SIG")),"^")
SET SIGOK=$PIECE(^("SIG"),"^",2)
IF SIGOK
Begin DoDot:1
+10 FOR I=0:0
SET I=$ORDER(^PSRX(PSORENW("OIRXN"),"SIG1",I))
IF 'I
QUIT
SET SIG(I)=^PSRX(PSORENW("OIRXN"),"SIG1",I,0)
End DoDot:1
+11 IF $PIECE(PSORENW("RX3"),"^",3)
SET PSORENW("COSIGNING PROVIDER")=$PIECE(PSORENW("RX3"),"^",3)
+12 SET PSORENW("PSODFN")=$PIECE(PSORENW("RX0"),"^",2)
+13 SET PSORENW("ORX #")=$PIECE(PSORENW("RX0"),"^")
+14 SET PSORENW("DRUG IEN")=$PIECE(PSORENW("RX0"),"^",6)
SET $PIECE(PSORENW("RX0"),"^",11)=$PIECE(OR0,"^",17)
+15 SET PSORENW("INS")=$SELECT($GET(PSORENW("INS"))]"":PSORENW("INS"),1:$GET(^PSRX(PSORENW("OIRXN"),"INS")))
+16 IF $GET(PSORENW("ENT"))>0
QUIT
+17 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
+18 SET PSORENW("ENT")=PSORENW("ENT")+1
SET PSORENW("DOSE",PSORENW("ENT"))=$PIECE(DOSE,"^")
+19 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)
+20 SET PSORENW("SCHEDULE",PSORENW("ENT"))=$PIECE(DOSE,"^",8)
SET PSORENW("DURATION",PSORENW("ENT"))=$PIECE(DOSE,"^",5)
SET PSORENW("CONJUNCTION",PSORENW("ENT"))=$PIECE(DOSE,"^",6)
+21 SET PSORENW("NOUN",PSORENW("ENT"))=$PIECE(DOSE,"^",4)
SET PSORENW("VERB",PSORENW("ENT"))=$PIECE(DOSE,"^",9)
+22 IF $GET(^PSRX(PSORENW("OIRXN"),6,I,1))]""
SET PSORENW("ODOSE",PSORENW("ENT"))=^PSRX(PSORENW("OIRXN"),6,I,1)
+23 KILL DOSE
End DoDot:1
+24 QUIT
+25 ;
SETIB ;Set defaults on Renewals with Copay information
+1 ;If answer is in Pending File, use that, else look in Prescription file
+2 NEW PSOOICD,JJJ
+3 KILL PSOSCP,PSOANSQ("SC>50")
DO SCP^PSORN52D
SET PSOANSQ("SC>50")=""
KILL PSOSCA
+4 IF '$GET(PSOIBOLD)
QUIT
+5 IF $GET(PSOFDR)
IF $GET(ORD)
DO SETIBP
QUIT
+6 ;I '$$DT^PSOMLLDT Q
+7 IF $GET(PSORX(PSOIBOLD,"SC"))'=0
IF $GET(PSORX(PSOIBOLD,"SC"))'=1
SET PSORX(PSOIBOLD,"SC")=$SELECT($PIECE($GET(^PSRX(PSOIBOLD,"IBQ")),"^")'="":$PIECE($GET(^("IBQ")),"^"),$PIECE($GET(^PSRX(PSOIBOLD,"IB")),"^"):0,1:"")
+8 IF $GET(PSORX(PSOIBOLD,"SC"))=""
KILL PSORX(PSOIBOLD,"SC")
+9 IF '$$DT^PSOMLLDT
QUIT
+10 IF $GET(PSORX(PSOIBOLD,"MST"))'=0
IF $GET(PSORX(PSOIBOLD,"MST"))'=1
IF $PIECE($GET(^PSRX(PSOIBOLD,"IBQ")),"^",2)'=""
SET PSORX(PSOIBOLD,"MST")=$PIECE($GET(^("IBQ")),"^",2)
+11 IF $GET(PSORX(PSOIBOLD,"VEH"))'=0
IF $GET(PSORX(PSOIBOLD,"VEH"))'=1
IF $PIECE($GET(^PSRX(PSOIBOLD,"IBQ")),"^",3)'=""
SET PSORX(PSOIBOLD,"VEH")=$PIECE($GET(^("IBQ")),"^",3)
+12 IF $GET(PSORX(PSOIBOLD,"RAD"))'=0
IF $GET(PSORX(PSOIBOLD,"RAD"))'=1
IF $PIECE($GET(^PSRX(PSOIBOLD,"IBQ")),"^",4)'=""
SET PSORX(PSOIBOLD,"RAD")=$PIECE($GET(^("IBQ")),"^",4)
+13 IF $GET(PSORX(PSOIBOLD,"PGW"))'=0
IF $GET(PSORX(PSOIBOLD,"PGW"))'=1
IF $PIECE($GET(^PSRX(PSOIBOLD,"IBQ")),"^",5)'=""
SET PSORX(PSOIBOLD,"PGW")=$PIECE($GET(^("IBQ")),"^",5)
+14 IF $GET(PSORX(PSOIBOLD,"HNC"))'=0
IF $GET(PSORX(PSOIBOLD,"HNC"))'=1
IF $PIECE($GET(^PSRX(PSOIBOLD,"IBQ")),"^",6)'=""
SET PSORX(PSOIBOLD,"HNC")=$PIECE($GET(^("IBQ")),"^",6)
+15 IF $GET(PSORX(PSOIBOLD,"CV"))'=0
IF $GET(PSORX(PSOIBOLD,"CV"))'=1
IF $PIECE($GET(^PSRX(PSOIBOLD,"IBQ")),"^",7)'=""
SET PSORX(PSOIBOLD,"CV")=$PIECE($GET(^("IBQ")),"^",7)
+16 IF $GET(PSORX(PSOIBOLD,"SHAD"))'=0
IF $GET(PSORX(PSOIBOLD,"SHAD"))'=1
IF $PIECE($GET(^PSRX(PSOIBOLD,"IBQ")),"^",8)'=""
SET PSORX(PSOIBOLD,"SHAD")=$PIECE($GET(^("IBQ")),"^",8)
+17 ;
SET2 ;for when patient status is exempt or SC>50
+1 IF $TRANSLATE($GET(^PSRX(PSOIBOLD,"IBQ")),"^")=""
SET PSOOICD=$GET(^PSRX(PSOIBOLD,"ICD",1,0))
IF PSOOICD'=""
DO SET3
+2 ;
ICD IF $DATA(^PSRX(PSORENW("OIRXN"),"ICD",0))
Begin DoDot:1
+1 NEW JJ,ICD,II,FLD,RXN
SET RXN=PSOIBOLD
+2 SET II=0
FOR
SET II=$ORDER(^PSRX(PSORENW("OIRXN"),"ICD",II))
IF II=""!(II'?1N.N)
QUIT
Begin DoDot:2
+3 SET ICD=^PSRX(PSORENW("OIRXN"),"ICD",II,0)
SET FLD=$PIECE(ICD,U)
DO ICD^PSONEWF
End DoDot:2
End DoDot:1
+4 QUIT
SET3 ;for when patient status is exempt or SC>50
+1 DO SET3^PSORN52D
+2 QUIT
+3 ;
SETIBP ;
+1 IF $PIECE($GET(^PS(52.41,ORD,0)),"^",16)="SC"!($PIECE($GET(^(0)),"^",16)="NSC")
SET PSORX(PSOIBOLD,"SC")=$SELECT($PIECE($GET(^(0)),"^",16)="SC":1,1:0)
+2 IF $GET(PSORX(PSOIBOLD,"SC"))=""
KILL PSORX(PSOIBOLD,"SC")
+3 IF '$$DT^PSOMLLDT
QUIT
+4 NEW PSOIBQFN
SET PSOIBQFN=$GET(^PS(52.41,ORD,"IBQ"))
+5 IF $PIECE(PSOIBQFN,"^",1)=0!($PIECE(PSOIBQFN,"^",1)=1)
SET PSORX(PSOIBOLD,"MST")=$PIECE(PSOIBQFN,"^")
+6 IF $PIECE(PSOIBQFN,"^",2)=0!($PIECE(PSOIBQFN,"^",2)=1)
SET PSORX(PSOIBOLD,"VEH")=$PIECE(PSOIBQFN,"^",2)
+7 IF $PIECE(PSOIBQFN,"^",3)=0!($PIECE(PSOIBQFN,"^",3)=1)
SET PSORX(PSOIBOLD,"RAD")=$PIECE(PSOIBQFN,"^",3)
+8 IF $PIECE(PSOIBQFN,"^",4)=0!($PIECE(PSOIBQFN,"^",4)=1)
SET PSORX(PSOIBOLD,"PGW")=$PIECE(PSOIBQFN,"^",4)
+9 IF $PIECE(PSOIBQFN,"^",5)=0!($PIECE(PSOIBQFN,"^",5)=1)
SET PSORX(PSOIBOLD,"HNC")=$PIECE(PSOIBQFN,"^",5)
+10 IF $PIECE(PSOIBQFN,"^",6)=0!($PIECE(PSOIBQFN,"^",6)=1)
SET PSORX(PSOIBOLD,"CV")=$PIECE(PSOIBQFN,"^",6)
+11 IF $PIECE(PSOIBQFN,"^",7)=0!($PIECE(PSOIBQFN,"^",7)=1)
SET PSORX(PSOIBOLD,"SHAD")=$PIECE(PSOIBQFN,"^",7)
+12 ;for when patient status is exempt, null IBQ node was set for exempts or SC>50 - data is in ICD node
+13 IF $TRANSLATE($GET(^PS(52.41,ORD,"IBQ")),"^")=""
SET PSOOICD=$GET(^PS(52.41,ORD,"ICD",1,0))
IF PSOOICD'=""
DO SET3
+14 ;
ICD2 ;
+1 IF $DATA(^PS(52.41,ORD,"ICD",0))
Begin DoDot:1
+2 NEW JJ,ICD,II,FLD,RXN
SET RXN=ORD
+3 SET II=0
FOR
SET II=$ORDER(^PS(52.41,ORD,"ICD",II))
IF II=""!(II'?1N.N)
QUIT
Begin DoDot:2
+4 SET ICD=""
SET ICD=^PS(52.41,ORD,"ICD",II,0)
+5 IF $GET(PSOSCP)>49&(II=1)
SET PSORX(PSOIBOLD,"SC>50")=$PIECE(ICD,"^",4)
+6 SET JJ=""
FOR JJ=1:1:9
SET FLD=$PIECE(ICD,U,JJ)
DO ICD^PSONEWF
End DoDot:2
End DoDot:1
+7 KILL PSOIBQFN
+8 QUIT
KLIB ;Kill renewal IB array
+1 IF '$GET(PSOIBOLD)
QUIT
+2 KILL PSORX(PSOIBOLD,"SC"),PSORX(PSOIBOLD,"MST"),PSORX(PSOIBOLD,"VEH"),PSORX(PSOIBOLD,"RAD"),PSORX(PSOIBOLD,"PGW"),PSORX(PSOIBOLD,"HNC"),PSORX(PSOIBOLD,"CV"),PSORX(PSOIBOLD,"SHAD")
+3 KILL PSOIBOLD
+4 QUIT
+5 ; IHS/CIA/PLS - 01/06/04
+6 ; API to set "PATIENT STATUS","QTY" and "ZCM" nodes
IHS ; EP
+1 SET PSORENW("QTY")=$PIECE(PSORENW("RX0"),"^",7)
+2 ; IHS/CIA/PLS - 03/30/05 - Changed array name
+3 ;S PSORENW("ZCM")=$P($G(^PSRX(PSORENW("OIRXN"),9999999)),"^",2) ; Check Chronic Med in old script
+4 ; Check Chronic Med in old script
SET PSORENW("CM")=$PIECE($GET(^PSRX(PSORENW("OIRXN"),9999999)),"^",2)
+5 IF '$LENGTH($GET(PSORENW("PATIENT STATUS")))
SET PSORENW("PATIENT STATUS")=$PIECE(PSORENW("RX0"),"^",3)
+6 QUIT
