- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOCPE.m
r613 r623 1 PSOCPE ;BIR/BAB - PHARMACY COPAY APPLICATION UTILITIES FOR IB ;10/26/92 2 ;;7.0;OUTPATPSOCT PHARMACY;**26,71,85,114,157,219,268,225**;DEC 1997;Build 29 3 ; 4 ;REF/IA 5 ;^XUSEC/10076 6 ;^PSDRUG(/221 7 ;Routine initially released as part of the copayment enhancement. 8 ;called from PSOLBL 9 INV ; Entry point from PSOCP - Prints one copay invoice 10 I '$D(PSOCPN)!($G(RXP)) Q 11 S PSOCPBAR=0 12 I $D(PSOBARS),PSOBARS S PSOCPBAR=1 13 D DEM^VADPT S Y=DT X ^DD("DD") S EDT=Y 14 W ?54,"PRESCRIPTION COPAYMENT INFORMATION" 15 W !!,?54,VADM(1)," ",VA("PID")," ",EDT 16 S PSZ1=0,PSZ2="",PSOCPBN=$P(VADM(2),"^"),PSOCPBN=$S(PSOCPBN]"":PSOCPBN,1:"Unavailable") 17 ;I '$G(PSOCPN) S PSOCPN=$P(^PSRX(RX,0),U,2) 18 I PSOCPBAR,(PSOCPBN]"") S X="S",X2=PSOCPBN W !,?54,@PSOBAR1,PSOCPBN,@PSOBAR0 19 E W ! 20 W !,?54,"The following prescriptions are" 21 W !,?54,"eligible for prescription copayment.",!! 22 DRUG S PSZ2="" F S PSZ2=$O(^TMP($J,"PSOCP",PSOCPN,PSZ2)) Q:PSZ2']"" S PSZ=^(PSZ2) D PRT 23 NAR ; Print narrative from site parameter file 24 K ^UTILITY($J,"W") S DIWL=55,DIWR=99,DIWF="" W ! 25 G:'$D(^PS(59,PSOSITE,4,0)) END 26 G:$P(^PS(59,PSOSITE,4,0),"^",3)'>0 END 27 F PSO9=0:0 S PSO9=$O(^PS(59,PSOSITE,4,PSO9)) G:'PSO9 P1 I $D(^PS(59,PSOSITE,4,PSO9,0)) S X=^(0) D ^DIWP 28 P1 D ^DIWW 29 K DIWF,DIWL,DIWR,PSO9 30 END ; 31 W @IOF 32 K ^TMP($J,"PSOCP",PSOCPN),PSOCPBAR,PSOCPBN,PSZ1,PSZ2,PSOCPN,DIWF,DIWL,DIWR,PSO9 33 Q 34 PRT ; 35 W ?54,PSZ2 36 W ?72," ",$P(^TMP($J,"PSOCP",PSOCPN,PSZ2),"^",3)," ","Days Supply",! 37 W ?56,$E($P(^TMP($J,"PSOCP",PSOCPN,PSZ2),U,2),1,45),! 38 Q 39 XMPT ; Entry point for menu option to select copay exemption 40 N PSORXPNM,PSORXPRE,PSOCPEDA 41 I '$D(PSOPAR) D ^PSOLSET G XMPT 42 W ! S (DIC,DIE)="^PS(53,",DIC(0)="AEQMZ" D ^DIC K DIC G:Y<0 QUIT 43 G:$D(DTOUT) QUIT 44 S PSORXPRE=$P($G(^PS(53,+$G(Y),0)),"^",7) 45 S PSORXPNM=$P($G(^PS(53,+$G(Y),0)),"^") 46 S DA=+Y,DR="15" L +^PS(53,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T W !!,PSORXPNM_" is locked by another user. Try Later!" W ! D PAGE G QUIT 47 W ! D ^DIE 48 I PSORXPRE,$P($G(^PS(53,DA,0)),"^",7) W !!,"All Rx's entered with this Rx Patient Status will be EXEMPT from Copayment.",! D PAGE L -^PS(53,DA) G QUIT 49 I 'PSORXPRE,'$P($G(^PS(53,DA,0)),"^",7) W !!,"All Rx's entered with this Rx Patient Status will NOT be exempt from Copayment.",! D PAGE L -^PS(53,DA) G QUIT 50 D WARN L -^PS(53,DA) 51 QUIT K PSORXPRE,DIE,DIC,DA,DR,X,C,Y 52 Q 53 PAGE ; 54 I '$G(DUZ("AUTO")) K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR 55 Q 56 WARN ; 57 S PSOCPEDA=$G(DA) 58 W !!?28,"**** WARNING ****",! 59 I 'PSORXPRE W !,"By setting the Exempt from Copayment for the Rx Patient Status of",!,PSORXPNM," to 'YES', every prescription entered",!,"with this Rx Patient Status will NOT be charged a Copayment.",! 60 I PSORXPRE W !,"By setting the EXEMPT FROM COPAYMENT for the Rx Patient Status of ",!,PSORXPNM," to 'NO', prescriptions entered with this Rx",!,"Patient Status from this point on will NOT be exempt from Copayment.",! 61 W !,"A mail message will be sent to PSORPH and PSO COPAY Key holders informing",!,"them of your change." 62 W ! K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to do this",DIR("B")="Y" D ^DIR K DIR 63 I $G(Y) D D MAIL G WARNX 64 .I 'PSORXPRE W !!,"Setting ",PSORXPNM," Rx Patient Status to Exempt from Copayment." Q 65 .W !!,"Setting Exempt from Copayment to 'NO' for the ",PSORXPNM,!,"Rx Patient Status." 66 I 'PSORXPRE W !!,"No action taken." S $P(^PS(53,PSOCPEDA,0),"^",7)=0 H 1 67 I PSORXPRE W !!,"No action taken." S $P(^PS(53,PSOCPEDA,0),"^",7)=1 H 1 68 WARNX W ! D PAGE 69 S DA=$G(PSOCPEDA) K PSOCPEDA 70 Q 71 MAIL ; 72 K PSOTXT,PSOCFN,PSODCPA 73 I $G(DUZ) S DIC=200,DR=".01",DA=DUZ,DIQ(0)="E",DIQ="PSODCPA(" D EN^DIQ1 S PSOCFN=$G(PSODCPA(200,DA,.01,"E")) K PSODCPA,DIC,DIQ,DR 74 I 'PSORXPRE S PSOTXT(1,0)="The "_PSORXPNM_" Rx Patient Status has been marked as",PSOTXT(2,0)="Exempt from Copayment by "_$G(PSOCFN)_".",PSOTXT(3,0)="Every prescription with this Rx Patient Status will not be charged a Copayment." 75 I PSORXPRE S PSOTXT(1,0)="The Exempt from Copayment status has been removed from the",PSOTXT(2,0)=PSORXPNM_" Rx Patient Status by "_$G(PSOCFN)_".",PSOTXT(3,0)="Prescriptions entered with this Rx Patient Status will not be exempt from" 76 I PSORXPRE S PSOTXT(4,0)="Copayment." 77 F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSORPH",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)="" 78 F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSO COPAY",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)="" 79 I $G(DUZ) S XMY(DUZ)="" 80 S XMSUB="Exempt from Copayment",XMTEXT="PSOTXT(",XMDUZ="Outpatient Pharmacy" D ^XMD 81 K PSOTXT,PSOCXPDA,XMDUZ,PSOCFN,XMTEXT,XMSUB,XMY 82 Q 83 ; 84 MAIL2 ; SEND MAIL TO PHARMACIST, PROVIDER, AND HOLDERS OF PSO COPAY KEY 85 N PSOC,PSOTXT,X 86 K XMY 87 S XMSUB="PRESCRIPTION QUESTIONS REVIEW NEEDED" 88 S XMDUZ="Outpatient Pharmacy Package" 89 S PSOTXT(1)=" " 90 S DFN=+$P($G(^PSRX(RXP,0)),"^",2) D PID^VADPT 91 S PSODIV=$P($G(^PSRX(RXP,2)),"^",9) S:PSODIV'="" XMSUB=XMSUB_" ("_$P($G(^PS(59,PSODIV,0)),"^",6)_")",PSODIV=$P($G(^PS(59,PSODIV,0)),"^",1) ; ADDED DIVISION NUMBER TO SUBJECT LINE - PATCH 85 92 S PSOTXT(2)=$P($G(^DPT($P(^PSRX(RXP,0),"^",2),0)),"^",1)_" ("_$G(VA("BID"))_")"_" "_PSODIV 93 D ELIG 94 S PSOTXT(PSOC)="Rx# "_$P(^PSRX(RXP,0),"^",1)_" ("_PSOREF_") "_$S('$G(^PSRX(RXP,"IB")):"NO COPAY",1:"COPAY") 95 S PSOC=PSOC+1 96 S DRG=+$P(^PSRX(RXP,0),"^",6) 97 S PSOC=PSOC+1 98 S PSOTXT(PSOC)=$P($G(^PSDRUG(DRG,0)),"^",1) 99 S PSOC=PSOC+1 100 S PSOTXT(PSOC)=" " 101 S PSOC=PSOC+1 102 S PSOTXT(PSOC)="Due to a change in criteria, additional information listed below is needed" 103 S PSOC=PSOC+1 104 S PSOTXT(PSOC)="to determine the final VA copay and/or insurance billable status for this Rx" 105 S PSOC=PSOC+1 106 S PSOTXT(PSOC)="so that appropriate action can be taken by pharmacy personnel." 107 S PSOC=PSOC+1 108 S PSOTXT(PSOC)=" " 109 S PSOC=PSOC+1 110 F EXMT="SC","CV","AO","IR","EC","SHAD","MST","HNC" I $D(PSOTG(EXMT)) D 111 . I PSOTG(EXMT)'="" Q 112 . S PSOLTAG="REL"_EXMT 113 . S PSOQUES=$P($T(@PSOLTAG),";",2) I PSOQUES="" Q 114 . S PSOC=PSOC+1,PSOTXT(PSOC)=PSOQUES 115 . S PSOQUES=$P($T(@PSOLTAG),";",2) I PSOQUES="" Q 116 S PSOC=PSOC+1,PSOTXT(PSOC)=" " 117 S PSOC=PSOC+1,PSOTXT(PSOC)="This message has been sent to the provider of record, the pharmacist who" 118 S PSOC=PSOC+1,PSOTXT(PSOC)="finished the prescription order, and all holders of the PSO COPAY key." 119 S PSOC=PSOC+1,PSOTXT(PSOC)=" " 120 S PSOC=PSOC+1,PSOTXT(PSOC)="Providers:" 121 S PSOC=PSOC+1,PSOTXT(PSOC)="Please respond with your answer to the question(s) as a reply to this" 122 S PSOC=PSOC+1,PSOTXT(PSOC)="message. The prescription will be updated by the appropriate staff." 123 S PSOC=PSOC+1,PSOTXT(PSOC)=" " 124 S PSOC=PSOC+1,PSOTXT(PSOC)="Staff assigned to update the Prescription responses:" 125 S PSOC=PSOC+1,PSOTXT(PSOC)="Please use the RESET COPAY STATUS/CANCEL CHARGES option to enter the responses" 126 S PSOC=PSOC+1,PSOTXT(PSOC)="to the questions above, which may result in a Rx copay status change and/or" 127 S PSOC=PSOC+1,PSOTXT(PSOC)="the need to remove VA copay charges or may result in a charge to the patient's" 128 S PSOC=PSOC+1,PSOTXT(PSOC)="insurance carrier." 129 S PSOC=PSOC+1,PSOTXT(PSOC)=" " 130 S PSOC=PSOC+1,PSOTXT(PSOC)="Note: The SC question is now asked for Veterans who are SC>49% in order to" 131 S PSOC=PSOC+1,PSOTXT(PSOC)="determine if the Rx can be billed to a third party insurance. These Veterans" 132 S PSOC=PSOC+1,PSOTXT(PSOC)="will NOT be charged a VA copay." 133 S PSOC=PSOC+1,PSOTXT(PSOC)=" " 134 S PSOC=PSOC+1,PSOTXT(PSOC)="Supply and investigational drugs are not charged a VA copay but could be" 135 S PSOC=PSOC+1,PSOTXT(PSOC)="reimbursable by third party insurance." 136 ; S XMY() TO ALL THE RECIPIENTS 137 I '$G(PSOREF) S XMY(+$P(^PSRX(RXP,0),"^",4))="" ; ORIGINAL 138 I $G(PSOREF) S XMY(+$P(^PSRX(RXP,1,PSOREF,0),"^",17))="" ; REFILL 139 I $G(^PSRX(RXP,"OR1")) I $P(^PSRX(RXP,"OR1"),"^",5)'="" S XMY($P(^PSRX(RXP,"OR1"),"^",5))="" 140 F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSO COPAY",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)="" 141 S XMTEXT="PSOTXT(" 142 D ^XMD K XMSUB,XMY,XMDUZ,XMTEXT,PSODIV,PSOCXPDA,PSOLTAG,PSOC,PSOQUES,PSOTG 143 Q 144 ; 145 ELIG D ELIG^VADPT S PSOC=3,PSOTXT(PSOC)="Eligibility: "_$P(VAEL(1),"^",2)_$S(+VAEL(3):" SC%: "_$P(VAEL(3),"^",2),1:""),PSOC=PSOC+1 146 N N,I,I1,PSDIS,PSCNT 147 S N=0 F S N=$O(VAEL(1,N)) Q:'N S $P(PSOTXT(PSOC)," ",14)=$P(VAEL(1,N),"^",2),PSOC=PSOC+1 148 S PSOTXT(PSOC)=" ",PSOC=PSOC+1,PSOTXT(PSOC)="Disabilities: " 149 F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I S I1=$S($D(^DPT(DFN,.372,I,0)):^(0),1:"") D:+I1 150 .S PSDIS=$S($P($G(^DIC(31,+I1,0)),"^")]""&($P($G(^(0)),"^",4)']""):$P(^(0),"^"),$P($G(^DIC(31,+I1,0)),"^",4)]"":$P(^(0),"^",4),1:""),PSCNT=$P(I1,"^",2) 151 .S:$L(PSOTXT(PSOC)_PSDIS_"-"_PSCNT_"% ("_$S($P(I1,"^",3):"SC",1:"NSC")_"), ")>80 PSOC=PSOC+1,$P(PSOTXT(PSOC)," ",14)=" " 152 .S PSOTXT(PSOC)=$G(PSOTXT(PSOC))_PSDIS_"-"_PSCNT_"%("_$S($P(I1,"^",3):"SC",1:"NSC")_"), " 153 S PSOC=PSOC+1 S PSOTXT(PSOC)=" ",PSOC=PSOC+1 154 Q 155 ; 156 ;EXEMPTION QUESTIONS - MAIL MESSAGE POSITION;SUBSCRIPT IN "IBQ" NODE 157 RELSC ;Is this Rx for a Service Connected Condition?;1 158 RELMST ;Is this Rx related to the treatment of Military Sexual Trauma?;2 159 RELAO ;Is this Rx for treatment of Vietnam-Era Herbicide (Agent Orange) exposure?;3 160 RELIR ;Is this Rx for treatment of Ionizing Radiation exposure?;4 161 RELEC ;Is this Rx for treatment related to service in SW Asia?;5 162 RELHNC ;Is this Rx related to treatment of Head and/or Neck Cancer?;6 163 RELCV ;Is this Rx potentially for treatment related to Combat?;7 164 RELSHAD ;Is this Rx related to treatment of PROJ 112/SHAD?;8 165 ; 1 PSOCPE ;BIR/BAB - PHARMACY COPAY APPLICATION UTILITIES FOR IB ;10/26/92 2 ;;7.0;OUTPATPSOCT PHARMACY;**26,71,85,114,157,219,268**;DEC 1997;Build 9 3 ; 4 ;REF/IA 5 ;^XUSEC/10076 6 ;^PSDRUG(/221 7 ;Routine initially released as part of the copayment enhancement. 8 ;called from PSOLBL 9 INV ; Entry point from PSOCP - Prints one copay invoice 10 I '$D(PSOCPN)!($G(RXP)) Q 11 S PSOCPBAR=0 12 I $D(PSOBARS),PSOBARS S PSOCPBAR=1 13 D DEM^VADPT S Y=DT X ^DD("DD") S EDT=Y 14 W ?54,"PRESCRIPTION COPAYMENT INFORMATION" 15 W !!,?54,VADM(1)," ",VA("PID")," ",EDT 16 S PSZ1=0,PSZ2="",PSOCPBN=$P(VADM(2),"^"),PSOCPBN=$S(PSOCPBN]"":PSOCPBN,1:"Unavailable") 17 ;I '$G(PSOCPN) S PSOCPN=$P(^PSRX(RX,0),U,2) 18 I PSOCPBAR,(PSOCPBN]"") S X="S",X2=PSOCPBN W !,?54,@PSOBAR1,PSOCPBN,@PSOBAR0 19 E W ! 20 W !,?54,"The following prescriptions are" 21 W !,?54,"eligible for prescription copayment.",!! 22 DRUG S PSZ2="" F S PSZ2=$O(^TMP($J,"PSOCP",PSOCPN,PSZ2)) Q:PSZ2']"" S PSZ=^(PSZ2) D PRT 23 NAR ; Print narrative from site parameter file 24 K ^UTILITY($J,"W") S DIWL=55,DIWR=99,DIWF="" W ! 25 G:'$D(^PS(59,PSOSITE,4,0)) END 26 G:$P(^PS(59,PSOSITE,4,0),"^",3)'>0 END 27 F PSO9=0:0 S PSO9=$O(^PS(59,PSOSITE,4,PSO9)) G:'PSO9 P1 I $D(^PS(59,PSOSITE,4,PSO9,0)) S X=^(0) D ^DIWP 28 P1 D ^DIWW 29 K DIWF,DIWL,DIWR,PSO9 30 END ; 31 W @IOF 32 K ^TMP($J,"PSOCP",PSOCPN),PSOCPBAR,PSOCPBN,PSZ1,PSZ2,PSOCPN,DIWF,DIWL,DIWR,PSO9 33 Q 34 PRT ; 35 W ?54,PSZ2 36 W ?72," ",$P(^TMP($J,"PSOCP",PSOCPN,PSZ2),"^",3)," ","Days Supply",! 37 W ?56,$E($P(^TMP($J,"PSOCP",PSOCPN,PSZ2),U,2),1,45),! 38 Q 39 XMPT ; Entry point for menu option to select copay exemption 40 N PSORXPNM,PSORXPRE,PSOCPEDA 41 I '$D(PSOPAR) D ^PSOLSET G XMPT 42 W ! S (DIC,DIE)="^PS(53,",DIC(0)="AEQMZ" D ^DIC K DIC G:Y<0 QUIT 43 G:$D(DTOUT) QUIT 44 S PSORXPRE=$P($G(^PS(53,+$G(Y),0)),"^",7) 45 S PSORXPNM=$P($G(^PS(53,+$G(Y),0)),"^") 46 S DA=+Y,DR="15" L +^PS(53,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T W !!,PSORXPNM_" is locked by another user. Try Later!" W ! D PAGE G QUIT 47 W ! D ^DIE 48 I PSORXPRE,$P($G(^PS(53,DA,0)),"^",7) W !!,"All Rx's entered with this Rx Patient Status will be EXEMPT from Copayment.",! D PAGE L -^PS(53,DA) G QUIT 49 I 'PSORXPRE,'$P($G(^PS(53,DA,0)),"^",7) W !!,"All Rx's entered with this Rx Patient Status will NOT be exempt from Copayment.",! D PAGE L -^PS(53,DA) G QUIT 50 D WARN L -^PS(53,DA) 51 QUIT K PSORXPRE,DIE,DIC,DA,DR,X,C,Y 52 Q 53 PAGE ; 54 I '$G(DUZ("AUTO")) K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR 55 Q 56 WARN ; 57 S PSOCPEDA=$G(DA) 58 W !!?28,"**** WARNING ****",! 59 I 'PSORXPRE W !,"By setting the Exempt from Copayment for the Rx Patient Status of",!,PSORXPNM," to 'YES', every prescription entered",!,"with this Rx Patient Status will NOT be charged a Copayment.",! 60 I PSORXPRE W !,"By setting the EXEMPT FROM COPAYMENT for the Rx Patient Status of ",!,PSORXPNM," to 'NO', prescriptions entered with this Rx",!,"Patient Status from this point on will NOT be exempt from Copayment.",! 61 W !,"A mail message will be sent to PSORPH and PSO COPAY Key holders informing",!,"them of your change." 62 W ! K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to do this",DIR("B")="Y" D ^DIR K DIR 63 I $G(Y) D D MAIL G WARNX 64 .I 'PSORXPRE W !!,"Setting ",PSORXPNM," Rx Patient Status to Exempt from Copayment." Q 65 .W !!,"Setting Exempt from Copayment to 'NO' for the ",PSORXPNM,!,"Rx Patient Status." 66 I 'PSORXPRE W !!,"No action taken." S $P(^PS(53,PSOCPEDA,0),"^",7)=0 H 1 67 I PSORXPRE W !!,"No action taken." S $P(^PS(53,PSOCPEDA,0),"^",7)=1 H 1 68 WARNX W ! D PAGE 69 S DA=$G(PSOCPEDA) K PSOCPEDA 70 Q 71 MAIL ; 72 K PSOTXT,PSOCFN,PSODCPA 73 I $G(DUZ) S DIC=200,DR=".01",DA=DUZ,DIQ(0)="E",DIQ="PSODCPA(" D EN^DIQ1 S PSOCFN=$G(PSODCPA(200,DA,.01,"E")) K PSODCPA,DIC,DIQ,DR 74 I 'PSORXPRE S PSOTXT(1,0)="The "_PSORXPNM_" Rx Patient Status has been marked as",PSOTXT(2,0)="Exempt from Copayment by "_$G(PSOCFN)_".",PSOTXT(3,0)="Every prescription with this Rx Patient Status will not be charged a Copayment." 75 I PSORXPRE S PSOTXT(1,0)="The Exempt from Copayment status has been removed from the",PSOTXT(2,0)=PSORXPNM_" Rx Patient Status by "_$G(PSOCFN)_".",PSOTXT(3,0)="Prescriptions entered with this Rx Patient Status will not be exempt from" 76 I PSORXPRE S PSOTXT(4,0)="Copayment." 77 F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSORPH",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)="" 78 F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSO COPAY",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)="" 79 I $G(DUZ) S XMY(DUZ)="" 80 S XMSUB="Exempt from Copayment",XMTEXT="PSOTXT(",XMDUZ="Outpatient Pharmacy" D ^XMD 81 K PSOTXT,PSOCXPDA,XMDUZ,PSOCFN,XMTEXT,XMSUB,XMY 82 Q 83 ; 84 MAIL2 ; SEND MAIL TO PHARMACIST, PROVIDER, AND HOLDERS OF PSO COPAY KEY 85 N PSOC,PSOTXT,X 86 K XMY 87 S XMSUB="PRESCRIPTION QUESTIONS REVIEW NEEDED" 88 S XMDUZ="Outpatient Pharmacy Package" 89 S PSOTXT(1)=" " 90 S DFN=+$P($G(^PSRX(RXP,0)),"^",2) D PID^VADPT 91 S PSODIV=$P($G(^PSRX(RXP,2)),"^",9) S:PSODIV'="" XMSUB=XMSUB_" ("_$P($G(^PS(59,PSODIV,0)),"^",6)_")",PSODIV=$P($G(^PS(59,PSODIV,0)),"^",1) ; ADDED DIVISION NUMBER TO SUBJECT LINE - PATCH 85 92 S PSOTXT(2)=$P($G(^DPT($P(^PSRX(RXP,0),"^",2),0)),"^",1)_" ("_$G(VA("BID"))_")"_" "_PSODIV 93 D ELIG 94 S PSOTXT(PSOC)="Rx# "_$P(^PSRX(RXP,0),"^",1)_" ("_PSOREF_") "_$S('$G(^PSRX(RXP,"IB")):"NO COPAY",1:"COPAY") 95 S PSOC=PSOC+1 96 S DRG=+$P(^PSRX(RXP,0),"^",6) 97 S PSOC=PSOC+1 98 S PSOTXT(PSOC)=$P($G(^PSDRUG(DRG,0)),"^",1) 99 S PSOC=PSOC+1 100 S PSOTXT(PSOC)=" " 101 S PSOC=PSOC+1 102 S PSOTXT(PSOC)="Due to a change in criteria, additional information listed below is needed" 103 S PSOC=PSOC+1 104 S PSOTXT(PSOC)="to determine the final VA copay and/or insurance billable status for this Rx" 105 S PSOC=PSOC+1 106 S PSOTXT(PSOC)="so that appropriate action can be taken by pharmacy personnel." 107 S PSOC=PSOC+1 108 S PSOTXT(PSOC)=" " 109 S PSOC=PSOC+1 110 F EXMT="SC","CV","AO","IR","EC","MST","HNC" I $D(PSOTG(EXMT)) D 111 . I PSOTG(EXMT)'="" Q 112 . S PSOLTAG="REL"_EXMT 113 . S PSOQUES=$P($T(@PSOLTAG),";",2) I PSOQUES="" Q 114 . S PSOC=PSOC+1,PSOTXT(PSOC)=PSOQUES 115 . S PSOQUES=$P($T(@PSOLTAG),";",2) I PSOQUES="" Q 116 S PSOC=PSOC+1,PSOTXT(PSOC)=" " 117 S PSOC=PSOC+1,PSOTXT(PSOC)="This message has been sent to the provider of record, the pharmacist who" 118 S PSOC=PSOC+1,PSOTXT(PSOC)="finished the prescription order, and all holders of the PSO COPAY key." 119 S PSOC=PSOC+1,PSOTXT(PSOC)=" " 120 S PSOC=PSOC+1,PSOTXT(PSOC)="Providers:" 121 S PSOC=PSOC+1,PSOTXT(PSOC)="Please respond with your answer to the question(s) as a reply to this" 122 S PSOC=PSOC+1,PSOTXT(PSOC)="message. The prescription will be updated by the appropriate staff." 123 S PSOC=PSOC+1,PSOTXT(PSOC)=" " 124 S PSOC=PSOC+1,PSOTXT(PSOC)="Staff assigned to update the Prescription responses:" 125 S PSOC=PSOC+1,PSOTXT(PSOC)="Please use the RESET COPAY STATUS/CANCEL CHARGES option to enter the responses" 126 S PSOC=PSOC+1,PSOTXT(PSOC)="to the questions above, which may result in a Rx copay status change and/or" 127 S PSOC=PSOC+1,PSOTXT(PSOC)="the need to remove VA copay charges or may result in a charge to the patient's" 128 S PSOC=PSOC+1,PSOTXT(PSOC)="insurance carrier." 129 S PSOC=PSOC+1,PSOTXT(PSOC)=" " 130 S PSOC=PSOC+1,PSOTXT(PSOC)="Note: The SC question is now asked for Veterans who are SC>49% in order to" 131 S PSOC=PSOC+1,PSOTXT(PSOC)="determine if the Rx can be billed to a third party insurance. These Veterans" 132 S PSOC=PSOC+1,PSOTXT(PSOC)="will NOT be charged a VA copay." 133 S PSOC=PSOC+1,PSOTXT(PSOC)=" " 134 S PSOC=PSOC+1,PSOTXT(PSOC)="Supply and investigational drugs are not charged a VA copay but could be" 135 S PSOC=PSOC+1,PSOTXT(PSOC)="reimbursable by third party insurance." 136 ; S XMY() TO ALL THE RECIPIENTS 137 I '$G(PSOREF) S XMY(+$P(^PSRX(RXP,0),"^",4))="" ; ORIGINAL 138 I $G(PSOREF) S XMY(+$P(^PSRX(RXP,1,PSOREF,0),"^",17))="" ; REFILL 139 I $G(^PSRX(RXP,"OR1")) I $P(^PSRX(RXP,"OR1"),"^",5)'="" S XMY($P(^PSRX(RXP,"OR1"),"^",5))="" 140 F PSOCXPDA=0:0 S PSOCXPDA=$O(^XUSEC("PSO COPAY",PSOCXPDA)) Q:'PSOCXPDA S XMY(PSOCXPDA)="" 141 S XMTEXT="PSOTXT(" 142 D ^XMD K XMSUB,XMY,XMDUZ,XMTEXT,PSODIV,PSOCXPDA,PSOLTAG,PSOC,PSOQUES,PSOTG 143 Q 144 ; 145 ELIG D ELIG^VADPT S PSOC=3,PSOTXT(PSOC)="Eligibility: "_$P(VAEL(1),"^",2)_$S(+VAEL(3):" SC%: "_$P(VAEL(3),"^",2),1:""),PSOC=PSOC+1 146 N N,I,I1,PSDIS,PSCNT 147 S N=0 F S N=$O(VAEL(1,N)) Q:'N S $P(PSOTXT(PSOC)," ",14)=$P(VAEL(1,N),"^",2),PSOC=PSOC+1 148 S PSOTXT(PSOC)=" ",PSOC=PSOC+1,PSOTXT(PSOC)="Disabilities: " 149 F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I S I1=$S($D(^DPT(DFN,.372,I,0)):^(0),1:"") D:+I1 150 .S PSDIS=$S($P($G(^DIC(31,+I1,0)),"^")]""&($P($G(^(0)),"^",4)']""):$P(^(0),"^"),$P($G(^DIC(31,+I1,0)),"^",4)]"":$P(^(0),"^",4),1:""),PSCNT=$P(I1,"^",2) 151 .S:$L(PSOTXT(PSOC)_PSDIS_"-"_PSCNT_"% ("_$S($P(I1,"^",3):"SC",1:"NSC")_"), ")>80 PSOC=PSOC+1,$P(PSOTXT(PSOC)," ",14)=" " 152 .S PSOTXT(PSOC)=$G(PSOTXT(PSOC))_PSDIS_"-"_PSCNT_"%("_$S($P(I1,"^",3):"SC",1:"NSC")_"), " 153 S PSOC=PSOC+1 S PSOTXT(PSOC)=" ",PSOC=PSOC+1 154 Q 155 ; 156 ;EXEMPTION QUESTIONS - MAIL MESSAGE POSITION;SUBSCRIPT IN "IBQ" NODE 157 RELSC ;Is this Rx for a Service Connected Condition?;1 158 RELMST ;Is this Rx related to the treatment of Military Sexual Trauma?;2 159 RELAO ;Is this Rx for treatment of Vietnam-Era Herbicide (Agent Orange) exposure?;3 160 RELIR ;Is this Rx for treatment of Ionizing Radiation exposure?;4 161 RELEC ;Is this Rx for treatment of Environmental Contaminants exposure?;5 162 RELHNC ;Is this Rx related to treatment of Head and/or Neck Cancer?;6 163 RELCV ;Is this Rx potentially for treatment related to Combat?;7 164 ;
Note:
See TracChangeset
for help on using the changeset viewer.
