| 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 | ;
|
|---|
