source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOMLLDT.m@ 1036

Last change on this file since 1036 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 9.6 KB
RevLine 
[623]1PSOMLLDT ;BIR/RTR - Copay date routine ;08/24/01
2 ;;7.0;OUTPATIENT PHARMACY;**71,157,143,219,278**;DEC 1997;Build 3
3 ;External reference SDC022 supported by DBIA 1579
4 ;External reference DGMSTAPI supported by DBIA2716
5 ;CIDC: Before doing EI question, check to see if should ask ei question
6 ; because the flag could have changed in enrollment and we shouldn't
7 ; ask if not flagged and should set nulls for answer if Rx is renewed
8 ; or copied when flags changed. Also, CPRS sometimes sends zeros for
9 ; null answers. 5/12/04
10DT() ;function for Copay date
11 ;0 means Copay not in effect, 1 means Copay in effect
12 N PSOMILDT
13 S PSOMILDT=3020101
14 I '$G(DT) S DT=$$DT^XLFDT
15 Q $S(DT<PSOMILDT:0,1:1)
16 ;
17 Q
18 ;New Copay questions, require if a Renewal
19 ;PSOFLAG=1 for New, PSOFLAG=0 for Renewal
20MST ;Military Sexual Trauma Question
21 I $G(PSODFN) I $P($$GETSTAT^DGMSTAPI(PSODFN),"^",2)'="Y" D Q
22 . K PSOANSQ("MST"),PSOANSQD("MST") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"MST")
23 N PSOUFLAG S PSOUFLAG=0
24 K DIR S DIR(0)="Y"
25 S DIR("A")="Was treatment related to Military Sexual Trauma"
26 S DIR("?")=" ",DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition related",DIR("?",2)="to Military Sexual Trauma. This response will be used to determine whether or"
27 S DIR("?",3)="not a copay should be applied to the prescription."
28 I '$G(PSOFLAG) S (DIR("B"),PSOUFLAG)=$S($G(PSORX(+$G(PSORENW("OIRXN")),"MST"))=0:"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"MST"))=1:"YES",1:"") I DIR("B")="" K DIR("B") S PSOUFLAG=0
29 I $G(PSOFLAG),$G(PSONEWFF) I $G(PSOANSQD("MST"))=0!($G(PSOANSQD("MST"))=1) S DIR("B")=$S($G(PSOANSQD("MST"))=1:"YES",1:"NO")
30 W ! D ^DIR K DIR
31 I $G(PSOFLAG) W ! D Q
32 .I Y["^"!($D(DUOUT))!($D(DTOUT)) S PSOCPZ("DFLG")=1 Q
33 .S PSOANSQ("MST")=Y
34 .I $G(PSONEWFF) S PSOANSQD("MST")=Y
35 I Y["^"!($D(DUOUT))!($D(DTOUT)) D W !!,"This Renewal has been designated as"_$S($G(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of Military",!,"Sexual Trauma." D:$G(PSOSCP)<50 MESSM D PAUSE Q
36 .S PSOANSQ(PSOX("IRXN"),"MST")=$S($G(PSOUFLAG)="YES":1,1:0)
37 I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"MST")=Y
38 E S PSOANSQ("MST")=Y
39 Q
40VEH ;Vietnam-Era Herbicide Question
41 I $G(PSODFN) I '$$AO^SDCO22(PSODFN) D Q
42 . K PSOANSQ("VEH"),PSOANSQD("VEH") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"VEH")
43 N PSOUFLAG S PSOUFLAG=0
44 K DIR S DIR(0)="Y"
45 S DIR("A")="Was treatment related to Agent Orange exposure"
46 S DIR("?")=" ",DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition due to",DIR("?",2)="Vietnam-Era Herbicide (Agent Orange) exposure. This response will be used to"
47 S DIR("?",3)="determine whether or not a copay should be applied to the prescription."
48 I '$G(PSOFLAG) S (DIR("B"),PSOUFLAG)=$S($G(PSORX(+$G(PSORENW("OIRXN")),"VEH"))=0:"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"VEH"))=1:"YES",1:"") I DIR("B")="" K DIR("B") S PSOUFLAG=0
49 I $G(PSOFLAG),$G(PSONEWFF) I $G(PSOANSQD("VEH"))=0!($G(PSOANSQD("VEH"))=1) S DIR("B")=$S($G(PSOANSQD("VEH"))=1:"YES",1:"NO")
50 W ! D ^DIR K DIR
51 I $G(PSOFLAG) W ! D Q
52 .I Y["^"!($D(DUOUT))!($D(DTOUT)) S PSOCPZ("DFLG")=1 Q
53 .S PSOANSQ("VEH")=Y
54 .I $G(PSONEWFF) S PSOANSQD("VEH")=Y
55 I Y["^"!($D(DUOUT))!($D(DTOUT)) D W !!,"This Renewal has been designated as"_$S($G(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of Vietnam-Era",!,"Herbicide (Agent Orange) exposure." D:$G(PSOSCP)<50 MESSV D PAUSE Q
56 .S PSOANSQ(PSOX("IRXN"),"VEH")=$S($G(PSOUFLAG)="YES":1,1:0)
57 I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"VEH")=Y
58 E S PSOANSQ("VEH")=Y
59 Q
60RAD ;Radiation question
61 I $G(PSODFN) I '$$IR^SDCO22(PSODFN) D Q
62 . K PSOANSQ("RAD"),PSOANSQD("RAD") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"RAD")
63 N PSOUFLAG S PSOUFLAG=0
64 K DIR S DIR(0)="Y"
65 S DIR("A")="Was treatment related to Ionizing Radiation exposure"
66 S DIR("?")=" ",DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition due to",DIR("?",2)="ionizing radiation exposure during military service. This response will be used"
67 S DIR("?",3)="to determine whether or not a copay should be applied to the prescription."
68 I '$G(PSOFLAG) S (DIR("B"),PSOUFLAG)=$S($G(PSORX(+$G(PSORENW("OIRXN")),"RAD"))=0:"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"RAD"))=1:"YES",1:"") I DIR("B")="" K DIR("B") S PSOUFLAG=0
69 I $G(PSOFLAG),$G(PSONEWFF) I $G(PSOANSQD("RAD"))=0!($G(PSOANSQD("RAD"))=1) S DIR("B")=$S($G(PSOANSQD("RAD"))=1:"YES",1:"NO")
70 W ! D ^DIR K DIR
71 I $G(PSOFLAG) W ! D Q
72 .I Y["^"!($D(DUOUT))!($G(DTOUT)) S PSOCPZ("DFLG")=1 Q
73 .S PSOANSQ("RAD")=Y
74 .I $G(PSONEWFF) S PSOANSQD("RAD")=Y
75 I Y["^"!($D(DUOUT))!($D(DTOUT)) D W !!,"This Renewal has been designated as"_$S($G(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of ionizing",!,"radiation exposure." D:$G(PSOSCP)<50 MESSM D PAUSE Q
76 .S PSOANSQ(PSOX("IRXN"),"RAD")=$S($G(PSOUFLAG)="YES":1,1:0)
77 I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"RAD")=Y
78 E S PSOANSQ("RAD")=Y
79 Q
80PGW ;Persian Gulf War question
81 I $G(PSODFN) I '$$EC^SDCO22(PSODFN) D Q
82 . K PSOANSQ("PGW"),PSOANSQD("PGW") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"PGW")
83 N PSOUFLAG S PSOUFLAG=0
84 K DIR S DIR(0)="Y"
85 S DIR("A")="Was treatment related to Environmental Contaminant exposure"
86 S DIR("?")=" ",DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition due to",DIR("?",2)="environmental contaminant exposure during the Persian Gulf War. This response"
87 S DIR("?",3)="will be used to determine whether or not a copay should be applied to the",DIR("?",4)="prescription."
88 I '$G(PSOFLAG) S (DIR("B"),PSOUFLAG)=$S($G(PSORX(+$G(PSORENW("OIRXN")),"PGW"))=0:"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"PGW"))=1:"YES",1:"") I DIR("B")="" K DIR("B") S PSOUFLAG=0
89 I $G(PSOFLAG),$G(PSONEWFF) I $G(PSOANSQD("PGW"))=0!($G(PSOANSQD("PGW"))=1) S DIR("B")=$S($G(PSOANSQD("PGW"))=1:"YES",1:"NO")
90 W ! D ^DIR K DIR
91 I $G(PSOFLAG) W ! D Q
92 .I Y["^"!($D(DUOUT))!($D(DTOUT)) S PSOCPZ("DFLG")=1 Q
93 .S PSOANSQ("PGW")=Y
94 .I $G(PSONEWFF) S PSOANSQD("PGW")=Y
95 I Y["^"!($D(DUOUT))!($D(DTOUT)) D W !!,"This Renewal has been designated as"_$S($G(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of",!,"environmental contaminant exposure during the Persian Gulf War." D:$G(PSOSCP)<50 MESS D PAUSE Q
96 .S PSOANSQ(PSOX("IRXN"),"PGW")=$S($G(PSOUFLAG)="YES":1,1:0)
97 I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"PGW")=Y
98 E S PSOANSQ("PGW")=Y
99 Q
100HNC ;Head or Neck Cancer question
101 I $G(PSODFN) I $T(GETCUR^DGNTAPI)]"" N PSONCP,PSONCPX S PSONCPX=$$GETCUR^DGNTAPI(PSODFN,"PSONCP") I $P($G(PSONCP("IND")),"^")'="Y" D Q
102 . K PSOANSQ("HNC"),PSOANSQD("HNC") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"HNC")
103 N PSOUFLAG S PSOUFLAG=0
104 K DIR S DIR(0)="Y"
105 S DIR("A")="Was treatment related to Head and/or Neck Cancer"
106 S DIR("?")=" ",DIR("?",1)="Enter 'Yes' if this prescription is being used to treat Head and/or Neck Cancer",DIR("?",2)="due to nose or throat radium treatments while in the military. This response"
107 S DIR("?",3)="will be used to determine whether or not a copay should be applied to the",DIR("?",4)="prescription."
108 I '$G(PSOFLAG) S (DIR("B"),PSOUFLAG)=$S($G(PSORX(+$G(PSORENW("OIRXN")),"HNC"))=0:"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"HNC"))=1:"YES",1:"") I DIR("B")="" K DIR("B") S PSOUFLAG=0
109 I $G(PSOFLAG),$G(PSONEWFF) I $G(PSOANSQD("HNC"))=0!($G(PSOANSQD("HNC"))=1) S DIR("B")=$S($G(PSOANSQD("HNC"))=1:"YES",1:"NO")
110 W ! D ^DIR K DIR
111 I $G(PSOFLAG) W ! D Q
112 .I Y["^"!($D(DUOUT))!($D(DTOUT)) S PSOCPZ("DFLG")=1 Q
113 .S PSOANSQ("HNC")=Y
114 .I $G(PSONEWFF) S PSOANSQD("HNC")=Y
115 I Y["^"!($D(DUOUT))!($D(DTOUT)) D W !!,"This Renewal has been designated as"_$S($G(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment related to",!,"Head and/or Neck Cancer." D:$G(PSOSCP)<50 MESSV D PAUSE Q
116 .S PSOANSQ(PSOX("IRXN"),"HNC")=$S($G(PSOUFLAG)="YES":1,1:0)
117 I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"HNC")=Y
118 E S PSOANSQ("HNC")=Y
119 Q
120CV ; Combat Veteran Question
121 I $G(PSODFN) I '(+$P($$CVEDT^DGCV(PSODFN),"^",3)) D Q
122 . K PSOANSQ("CV"),PSOANSQD("CV") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"CV")
123 N PSOUFLAG S PSOUFLAG=0
124 K DIR S DIR(0)="Y"
125 S DIR("A")="Was treatment related to Combat"
126 S DIR("?")=" "
127 S DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition due to"
128 S DIR("?",2)="active duty in a theater of combat operations during a period of war after the"
129 S DIR("?",3)="Gulf War. This response will be used to determine whether or not a copay should"
130 S DIR("?",4)="be applied to the prescription."
131 S DIR("B")="YES"
132 I '$G(PSOFLAG) D
133 . S (DIR("B"),PSOUFLAG)=$S($G(PSORX(+$G(PSORENW("OIRXN")),"CV"))=0:"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"CV"))=1:"YES",1:"")
134 . I DIR("B")="" S (PSOUFLAG,DIR("B"))="YES"
135 I $G(PSOFLAG),$G(PSONEWFF) D
136 . I $G(PSOANSQD("CV"))=0!($G(PSOANSQD("CV"))=1) D
137 . . S DIR("B")=$S($G(PSOANSQD("CV"))=1:"YES",1:"NO")
138 W ! D ^DIR K DIR
139 I $G(PSOFLAG) W ! D Q
140 . I Y["^"!($D(DUOUT))!($G(DTOUT)) S PSOCPZ("DFLG")=1 Q
141 . S PSOANSQ("CV")=Y
142 . I $G(PSONEWFF) S PSOANSQD("CV")=Y
143 I Y["^"!($D(DUOUT))!($D(DTOUT)) D Q
144 . W !!,"This Renewal has been designated as"_$S($G(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of military"
145 . W !,"combat service." D:$G(PSOSCP)<50 MESSM D PAUSE
146 . S PSOANSQ(PSOX("IRXN"),"CV")=$S($G(PSOUFLAG)="YES":1,1:0)
147 I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"CV")=Y
148 E S PSOANSQ("CV")=Y
149 Q
150PAUSE ;
151 K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
152 Q
153MESS ;
154 Q:$G(PSODRUG("DEA"))["S"!($G(PSODRUG("DEA"))["I")
155 W !,"Please use the 'Reset Copay Status/Cancel Charges' option to make corrections.",!
156 Q
157MESSM ;
158 Q:$G(PSODRUG("DEA"))["S"!($G(PSODRUG("DEA"))["I")
159 W " Please use the 'Reset Copay Status/Cancel Charges' option",!,"to make corrections.",!
160 Q
161MESSV ;
162 Q:$G(PSODRUG("DEA"))["S"!($G(PSODRUG("DEA"))["I")
163 W " Please use the 'Reset Copay Status/Cancel",!,"Charges' option to make corrections.",!
Note: See TracBrowser for help on using the repository browser.