- PSORENW1 ;BIR/DSD - Renew Main Driver Continuation ;Dec 07, 2021@08:44:31
- ;;7.0;OUTPATIENT PHARMACY;**20,37,51,46,71,117,157,143,219,239,225,444,548,587,441,753**;DEC 1997;Build 53
- ;External reference ^VA(200 supported by DBIA 10060
- ;
- 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 PSORENW("RX7")=$G(^PSRX(PSORENW("OIRXN"),7)) ;p753
- 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)),"^")
- 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("MAIL EXEMPTION")=$P($G(PSORENW("RX7")),"^",2) ;p753
- 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),$P(PSORENW("RX0"),"^",8)=$P(OR0,"^",22)
- .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
- .; Retrieving the Maximum Number of Refills allowed
- .S RFMX=$$MAXNUMRF^PSOUTIL(+$G(PSODRUG("IEN")),+$G(PSORENW("DAYS SUPPLY")),+$P(^PSRX(PSORENW("OIRXN"),0),"^",3),.CLOZPAT)
- .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
- S:'$G(PSORENW("QTY")) PSORENW("QTY")=$P(PSORENW("RX0"),"^",7)
- S:'$G(PSORENW("DAYS SUPPLY")) PSORENW("DAYS SUPPLY")=$P(PSORENW("RX0"),"^",8)
- D DAYSUP^PSOUTIL($P(PSORENW("RX0"),"^",6),.PSORENW,1)
- 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
- S X2=$S(DAYS=X2&('DEA("CS")):X2,DEA("CS"):184,1:366)
- I X2<30 D ;*587 - match PSON52 calc for an expiration date, for X2, in the same manner
- . N % S %=$S($D(PSORX("PATIENT STATUS"))&PSORX("PATIENT STATUS"):$P(PSORX("PATIENT STATUS"),"^"),1:$O(^PS(53,"B",PSORX("PATIENT STATUS"),""))),X2=30
- . S:%?.N %=$P($G(^PS(53,+%,0)),"^") I %["AUTH ABS" S X2=5
- D C^%DTC
- I PSORENW("FILL DATE")>$P(X,".") S PSEXDT=1_"^"_$P(X,".")
- K X1,X2,X,%DT,DEA("CS")
- 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)
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORENW1 10113 printed Jan 18, 2025@03:34:54 Page 2
- PSORENW1 ;BIR/DSD - Renew Main Driver Continuation ;Dec 07, 2021@08:44:31
- +1 ;;7.0;OUTPATIENT PHARMACY;**20,37,51,46,71,117,157,143,219,239,225,444,548,587,441,753**;DEC 1997;Build 53
- +2 ;External reference ^VA(200 supported by DBIA 10060
- +3 ;
- 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 ;p753
- SET PSORENW("RX7")=$GET(^PSRX(PSORENW("OIRXN"),7))
- +3 SET PSOIBOLD=$GET(PSORENW("OIRXN"))
- +4 DO SETIB
- +5 SET PSORENW("PROVIDER")=$PIECE(PSORENW("RX0"),"^",4)
- +6 SET PSORX("PROVIDER NAME")=$PIECE($GET(^VA(200,PSORENW("PROVIDER"),0)),"^")
- +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 ;p753
- SET PSORENW("MAIL EXEMPTION")=$PIECE($GET(PSORENW("RX7")),"^",2)
- +11 SET PSORENW("SIG")=$PIECE($GET(^PSRX(PSORENW("OIRXN"),"SIG")),"^")
- +12 if $PIECE(PSORENW("RX3"),"^",3)
- SET PSORENW("COSIGNING PROVIDER")=$PIECE(PSORENW("RX3"),"^",3)
- +13 SET (PSODFN,PSORENW("PSODFN"))=$PIECE(PSORENW("RX0"),"^",2)
- +14 SET PSORENW("ORX #")=$PIECE(PSORENW("RX0"),"^")
- +15 SET PSORENW("DRUG IEN")=$PIECE(PSORENW("RX0"),"^",6)
- +16 SET PSORENW("INS")=$SELECT($GET(PSORENW("INS"))]"":PSORENW("INS"),1:$GET(^PSRX(PSORENW("OIRXN"),"INS")))
- +17 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)
- +18 IF '$ORDER(PSORENW("SIG",0))
- IF $GET(PSORENW("INS"))]""
- SET PSORENW("SIG",1)=PSORENW("INS")
- +19 if $GET(PSORENW("ENT"))
- GOTO FDR
- +20 IF $GET(PSORENW("ENT"))'>0
- IF '$ORDER(^PSRX(PSORENW("OIRXN"),6,0))
- SET PSORENW("ENT")=0
- GOTO FDR
- +21 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
- +22 SET PSORENW("ENT")=$GET(PSORENW("ENT"))+1
- SET PSORENW("DOSE",PSORENW("ENT"))=$PIECE(DOSE,"^")
- +23 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)
- +24 SET PSORENW("SCHEDULE",PSORENW("ENT"))=$PIECE(DOSE,"^",8)
- SET PSORENW("DURATION",PSORENW("ENT"))=$PIECE(DOSE,"^",5)
- SET PSORENW("CONJUNCTION",PSORENW("ENT"))=$PIECE(DOSE,"^",6)
- +25 SET PSORENW("NOUN",PSORENW("ENT"))=$PIECE(DOSE,"^",4)
- SET PSORENW("VERB",PSORENW("ENT"))=$PIECE(DOSE,"^",9)
- +26 IF $GET(^PSRX(PSORENW("OIRXN"),6,I,1))]""
- SET PSORENW("ODOSE",PSORENW("ENT"))=^PSRX(PSORENW("OIRXN"),6,I,1)
- +27 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)
- SET $PIECE(PSORENW("RX0"),"^",8)=$PIECE(OR0,"^",22)
- +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 ; Retrieving the Maximum Number of Refills allowed
- +10 SET RFMX=$$MAXNUMRF^PSOUTIL(+$GET(PSODRUG("IEN")),+$GET(PSORENW("DAYS SUPPLY")),+$PIECE(^PSRX(PSORENW("OIRXN"),0),"^",3),.CLOZPAT)
- +11 SET $PIECE(PSORENW("RX0"),"^",9)=$SELECT($PIECE(OR0,"^",11)'>RFMX:$PIECE(OR0,"^",11),1:RFMX)
- SET $PIECE(OR0,"^",11)=$PIECE(PSORENW("RX0"),"^",9)
- +12 KILL RFMX,PSODIR("CS"),PSDY
- End DoDot:1
- +13 if '$GET(PSORENW("QTY"))
- SET PSORENW("QTY")=$PIECE(PSORENW("RX0"),"^",7)
- +14 if '$GET(PSORENW("DAYS SUPPLY"))
- SET PSORENW("DAYS SUPPLY")=$PIECE(PSORENW("RX0"),"^",8)
- +15 DO DAYSUP^PSOUTIL($PIECE(PSORENW("RX0"),"^",6),.PSORENW,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 SET X2=$SELECT(DAYS=X2&('DEA("CS")):X2,DEA("CS"):184,1:366)
- +5 ;*587 - match PSON52 calc for an expiration date, for X2, in the same manner
- IF X2<30
- Begin DoDot:1
- +6 NEW %
- SET %=$SELECT($DATA(PSORX("PATIENT STATUS"))&PSORX("PATIENT STATUS"):$PIECE(PSORX("PATIENT STATUS"),"^"),1:$ORDER(^PS(53,"B",PSORX("PATIENT STATUS"),"")))
- SET X2=30
- +7 if %?.N
- SET %=$PIECE($GET(^PS(53,+%,0)),"^")
- IF %["AUTH ABS"
- SET X2=5
- End DoDot:1
- +8 DO C^%DTC
- +9 IF PSORENW("FILL DATE")>$PIECE(X,".")
- SET PSEXDT=1_"^"_$PIECE(X,".")
- +10 KILL X1,X2,X,%DT,DEA("CS")
- +11 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 SET PSORENW("CLINIC")=$PIECE(OR0,"^",13)
- +7 SET PSORENW("REMARKS")="RENEWED FROM RX # "_$PIECE(PSORENW("RX0"),"^")_"."_$SELECT($PIECE(OR0,"^",17)="C":" Administered in Clinic.",1:"")
- +8 SET PSORENW("SIG")=$PIECE($GET(^PSRX(PSORENW("OIRXN"),"SIG")),"^")
- SET SIGOK=$PIECE(^("SIG"),"^",2)
- IF SIGOK
- Begin DoDot:1
- +9 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
- +10 if $PIECE(PSORENW("RX3"),"^",3)
- SET PSORENW("COSIGNING PROVIDER")=$PIECE(PSORENW("RX3"),"^",3)
- +11 SET PSORENW("PSODFN")=$PIECE(PSORENW("RX0"),"^",2)
- +12 SET PSORENW("ORX #")=$PIECE(PSORENW("RX0"),"^")
- +13 SET PSORENW("DRUG IEN")=$PIECE(PSORENW("RX0"),"^",6)
- SET $PIECE(PSORENW("RX0"),"^",11)=$PIECE(OR0,"^",17)
- +14 SET PSORENW("INS")=$SELECT($GET(PSORENW("INS"))]"":PSORENW("INS"),1:$GET(^PSRX(PSORENW("OIRXN"),"INS")))
- +15 if $GET(PSORENW("ENT"))>0
- QUIT
- +16 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
- +17 SET PSORENW("ENT")=PSORENW("ENT")+1
- SET PSORENW("DOSE",PSORENW("ENT"))=$PIECE(DOSE,"^")
- +18 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)
- +19 SET PSORENW("SCHEDULE",PSORENW("ENT"))=$PIECE(DOSE,"^",8)
- SET PSORENW("DURATION",PSORENW("ENT"))=$PIECE(DOSE,"^",5)
- SET PSORENW("CONJUNCTION",PSORENW("ENT"))=$PIECE(DOSE,"^",6)
- +20 SET PSORENW("NOUN",PSORENW("ENT"))=$PIECE(DOSE,"^",4)
- SET PSORENW("VERB",PSORENW("ENT"))=$PIECE(DOSE,"^",9)
- +21 IF $GET(^PSRX(PSORENW("OIRXN"),6,I,1))]""
- SET PSORENW("ODOSE",PSORENW("ENT"))=^PSRX(PSORENW("OIRXN"),6,I,1)
- +22 KILL DOSE
- End DoDot:1
- +23 QUIT
- +24 ;
- 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