- PSOMLLDT ;BIR/RTR - Copay date routine ;08/24/01
- ;;7.0;OUTPATIENT PHARMACY;**71,157,143,219,278,225,303**;DEC 1997;Build 19
- ;External reference SDC022 supported by DBIA 1579
- ;External reference DGMSTAPI supported by DBIA2716
- ;CIDC: Before doing EI question, check to see if should ask ei question
- ; because the flag could have changed in enrollment and we shouldn't
- ; ask if not flagged and should set nulls for answer if Rx is renewed
- ; or copied when flags changed. Also, CPRS sometimes sends zeros for
- ; null answers. 5/12/04
- DT() ;function for Copay date
- ;0 means Copay not in effect, 1 means Copay in effect
- N PSOMILDT
- S PSOMILDT=3020101
- I '$G(DT) S DT=$$DT^XLFDT
- Q $S(DT<PSOMILDT:0,1:1)
- ;
- Q
- ;New Copay questions, require if a Renewal
- ;PSOFLAG=1 for New, PSOFLAG=0 for Renewal
- MST ;Military Sexual Trauma Question
- I $G(PSODFN) I $P($$GETSTAT^DGMSTAPI(PSODFN),"^",2)'="Y" D Q
- . K PSOANSQ("MST"),PSOANSQD("MST") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"MST")
- N PSOUFLAG S PSOUFLAG=0
- K DIR S DIR(0)="Y"
- S DIR("A")="Was treatment related to Military Sexual Trauma"
- 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"
- S DIR("?",3)="not a copay should be applied to the prescription."
- 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
- 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")
- W ! D ^DIR K DIR
- I $G(PSOFLAG) W ! D Q
- .I Y["^"!($D(DUOUT))!($D(DTOUT)) S PSOCPZ("DFLG")=1 Q
- .S PSOANSQ("MST")=Y
- .I $G(PSONEWFF) S PSOANSQD("MST")=Y
- 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
- .S PSOANSQ(PSOX("IRXN"),"MST")=$S($G(PSOUFLAG)="YES":1,1:0)
- I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"MST")=Y
- E S PSOANSQ("MST")=Y
- Q
- VEH ;Vietnam-Era Herbicide Question
- I $G(PSODFN) I '$$AO^SDCO22(PSODFN) D Q
- . K PSOANSQ("VEH"),PSOANSQD("VEH") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"VEH")
- N PSOUFLAG S PSOUFLAG=0
- K DIR S DIR(0)="Y"
- S DIR("A")="Was treatment related to Agent Orange exposure"
- 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"
- S DIR("?",3)="determine whether or not a copay should be applied to the prescription."
- 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
- 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")
- W ! D ^DIR K DIR
- I $G(PSOFLAG) W ! D Q
- .I Y["^"!($D(DUOUT))!($D(DTOUT)) S PSOCPZ("DFLG")=1 Q
- .S PSOANSQ("VEH")=Y
- .I $G(PSONEWFF) S PSOANSQD("VEH")=Y
- 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
- .S PSOANSQ(PSOX("IRXN"),"VEH")=$S($G(PSOUFLAG)="YES":1,1:0)
- I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"VEH")=Y
- E S PSOANSQ("VEH")=Y
- Q
- RAD ;Radiation question
- I $G(PSODFN) I '$$IR^SDCO22(PSODFN) D Q
- . K PSOANSQ("RAD"),PSOANSQD("RAD") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"RAD")
- N PSOUFLAG S PSOUFLAG=0
- K DIR S DIR(0)="Y"
- S DIR("A")="Was treatment related to Ionizing Radiation exposure"
- 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"
- S DIR("?",3)="to determine whether or not a copay should be applied to the prescription."
- 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
- 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")
- W ! D ^DIR K DIR
- I $G(PSOFLAG) W ! D Q
- .I Y["^"!($D(DUOUT))!($G(DTOUT)) S PSOCPZ("DFLG")=1 Q
- .S PSOANSQ("RAD")=Y
- .I $G(PSONEWFF) S PSOANSQD("RAD")=Y
- 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
- .S PSOANSQ(PSOX("IRXN"),"RAD")=$S($G(PSOUFLAG)="YES":1,1:0)
- I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"RAD")=Y
- E S PSOANSQ("RAD")=Y
- Q
- PGW ;Persian Gulf War question
- I $G(PSODFN) I '$$EC^SDCO22(PSODFN) D Q
- . K PSOANSQ("PGW"),PSOANSQD("PGW") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"PGW")
- N PSOUFLAG S PSOUFLAG=0
- K DIR S DIR(0)="Y"
- S DIR("A")="Was treatment related to service in SW Asia"
- S DIR("?")=" ",DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition related to"
- S DIR("?",2)="service in Southwest Asia. This response will be used to determine whether or"
- S DIR("?",3)="not a copay should be applied to the prescription."
- 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
- 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")
- W ! D ^DIR K DIR
- I $G(PSOFLAG) W ! D Q
- .I Y["^"!($D(DUOUT))!($D(DTOUT)) S PSOCPZ("DFLG")=1 Q
- .S PSOANSQ("PGW")=Y
- .I $G(PSONEWFF) S PSOANSQD("PGW")=Y
- 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",!,"Southwest Asia Conditions exposure." D:$G(PSOSCP)<50 MESS D PAUSE Q
- .S PSOANSQ(PSOX("IRXN"),"PGW")=$S($G(PSOUFLAG)="YES":1,1:0)
- I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"PGW")=Y
- E S PSOANSQ("PGW")=Y
- Q
- HNC ;Head or Neck Cancer question
- I $G(PSODFN) I $T(GETCUR^DGNTAPI)]"" N PSONCP,PSONCPX S PSONCPX=$$GETCUR^DGNTAPI(PSODFN,"PSONCP") I $P($G(PSONCP("IND")),"^")'="Y" D Q
- . K PSOANSQ("HNC"),PSOANSQD("HNC") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"HNC")
- N PSOUFLAG S PSOUFLAG=0
- K DIR S DIR(0)="Y"
- S DIR("A")="Was treatment related to Head and/or Neck Cancer"
- 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"
- S DIR("?",3)="will be used to determine whether or not a copay should be applied to the",DIR("?",4)="prescription."
- 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
- 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")
- W ! D ^DIR K DIR
- I $G(PSOFLAG) W ! D Q
- .I Y["^"!($D(DUOUT))!($D(DTOUT)) S PSOCPZ("DFLG")=1 Q
- .S PSOANSQ("HNC")=Y
- .I $G(PSONEWFF) S PSOANSQD("HNC")=Y
- 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
- .S PSOANSQ(PSOX("IRXN"),"HNC")=$S($G(PSOUFLAG)="YES":1,1:0)
- I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"HNC")=Y
- E S PSOANSQ("HNC")=Y
- Q
- CV ; Combat Veteran Question
- I $G(PSODFN) I '(+$P($$CVEDT^DGCV(PSODFN),"^",3)) D Q
- . K PSOANSQ("CV"),PSOANSQD("CV") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"CV")
- N PSOUFLAG S PSOUFLAG=0
- K DIR S DIR(0)="Y"
- S DIR("A")="Was treatment related to Combat"
- S DIR("?")=" "
- S DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition due to"
- S DIR("?",2)="active duty in a theater of combat operations during a period of war after the"
- S DIR("?",3)="Gulf War. This response will be used to determine whether or not a copay should"
- S DIR("?",4)="be applied to the prescription."
- S DIR("B")="YES"
- I '$G(PSOFLAG) D
- . S (DIR("B"),PSOUFLAG)=$S($G(PSORX(+$G(PSORENW("OIRXN")),"CV"))=0:"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"CV"))=1:"YES",1:"")
- . I DIR("B")="" S (PSOUFLAG,DIR("B"))="YES"
- I $G(PSOFLAG),$G(PSONEWFF) D
- . I $G(PSOANSQD("CV"))=0!($G(PSOANSQD("CV"))=1) D
- . . S DIR("B")=$S($G(PSOANSQD("CV"))=1:"YES",1:"NO")
- W ! D ^DIR K DIR
- I $G(PSOFLAG) W ! D Q
- . I Y["^"!($D(DUOUT))!($G(DTOUT)) S PSOCPZ("DFLG")=1 Q
- . S PSOANSQ("CV")=Y
- . I $G(PSONEWFF) S PSOANSQD("CV")=Y
- I Y["^"!($D(DUOUT))!($D(DTOUT)) D Q
- . W !!,"This Renewal has been designated as"_$S($G(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of military"
- . W !,"combat service." D:$G(PSOSCP)<50 MESSM D PAUSE
- . S PSOANSQ(PSOX("IRXN"),"CV")=$S($G(PSOUFLAG)="YES":1,1:0)
- I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"CV")=Y
- E S PSOANSQ("CV")=Y
- Q
- PAUSE ;
- K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- Q
- MESS ;
- Q:$G(PSODRUG("DEA"))["S"!($G(PSODRUG("DEA"))["I")!($G(PSODRUG("DEA"))["N")
- W !,"Please use the 'Reset Copay Status/Cancel Charges' option to make corrections.",!
- Q
- MESSM ;
- Q:$G(PSODRUG("DEA"))["S"!($G(PSODRUG("DEA"))["I")!($G(PSODRUG("DEA"))["N")
- W " Please use the 'Reset Copay Status/Cancel Charges' option",!,"to make corrections.",!
- Q
- MESSV ;
- Q:$G(PSODRUG("DEA"))["S"!($G(PSODRUG("DEA"))["I")!($G(PSODRUG("DEA"))["N")
- W " Please use the 'Reset Copay Status/Cancel",!,"Charges' option to make corrections.",!
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOMLLDT 9969 printed Jan 18, 2025@03:32:24 Page 2
- PSOMLLDT ;BIR/RTR - Copay date routine ;08/24/01
- +1 ;;7.0;OUTPATIENT PHARMACY;**71,157,143,219,278,225,303**;DEC 1997;Build 19
- +2 ;External reference SDC022 supported by DBIA 1579
- +3 ;External reference DGMSTAPI supported by DBIA2716
- +4 ;CIDC: Before doing EI question, check to see if should ask ei question
- +5 ; because the flag could have changed in enrollment and we shouldn't
- +6 ; ask if not flagged and should set nulls for answer if Rx is renewed
- +7 ; or copied when flags changed. Also, CPRS sometimes sends zeros for
- +8 ; null answers. 5/12/04
- DT() ;function for Copay date
- +1 ;0 means Copay not in effect, 1 means Copay in effect
- +2 NEW PSOMILDT
- +3 SET PSOMILDT=3020101
- +4 IF '$GET(DT)
- SET DT=$$DT^XLFDT
- +5 QUIT $SELECT(DT<PSOMILDT:0,1:1)
- +6 ;
- +7 QUIT
- +8 ;New Copay questions, require if a Renewal
- +9 ;PSOFLAG=1 for New, PSOFLAG=0 for Renewal
- MST ;Military Sexual Trauma Question
- +1 IF $GET(PSODFN)
- IF $PIECE($$GETSTAT^DGMSTAPI(PSODFN),"^",2)'="Y"
- Begin DoDot:1
- +2 KILL PSOANSQ("MST"),PSOANSQD("MST")
- IF $GET(PSOX("IRXN"))
- KILL PSOANSQ(PSOX("IRXN"),"MST")
- End DoDot:1
- QUIT
- +3 NEW PSOUFLAG
- SET PSOUFLAG=0
- +4 KILL DIR
- SET DIR(0)="Y"
- +5 SET DIR("A")="Was treatment related to Military Sexual Trauma"
- +6 SET DIR("?")=" "
- SET DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition related"
- SET DIR("?",2)="to Military Sexual Trauma. This response will be used to determine whether or"
- +7 SET DIR("?",3)="not a copay should be applied to the prescription."
- +8 IF '$GET(PSOFLAG)
- SET (DIR("B"),PSOUFLAG)=$SELECT($GET(PSORX(+$GET(PSORENW("OIRXN")),"MST"))=0:"NO",$GET(PSORX(+$GET(PSORENW("OIRXN")),"MST"))=1:"YES",1:"")
- IF DIR("B")=""
- KILL DIR("B")
- SET PSOUFLAG=0
- +9 IF $GET(PSOFLAG)
- IF $GET(PSONEWFF)
- IF $GET(PSOANSQD("MST"))=0!($GET(PSOANSQD("MST"))=1)
- SET DIR("B")=$SELECT($GET(PSOANSQD("MST"))=1:"YES",1:"NO")
- +10 WRITE !
- DO ^DIR
- KILL DIR
- +11 IF $GET(PSOFLAG)
- WRITE !
- Begin DoDot:1
- +12 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
- SET PSOCPZ("DFLG")=1
- QUIT
- +13 SET PSOANSQ("MST")=Y
- +14 IF $GET(PSONEWFF)
- SET PSOANSQD("MST")=Y
- End DoDot:1
- QUIT
- +15 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
- Begin DoDot:1
- +16 SET PSOANSQ(PSOX("IRXN"),"MST")=$SELECT($GET(PSOUFLAG)="YES":1,1:0)
- End DoDot:1
- WRITE !!,"This Renewal has been designated as"_$SELECT($GET(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of Military",!,"Sexual Trauma."
- if $GET(PSOSCP)<50
- DO MESSM
- DO PAUSE
- QUIT
- +17 IF $GET(PSOX("IRXN"))
- SET PSOANSQ(PSOX("IRXN"),"MST")=Y
- +18 IF '$TEST
- SET PSOANSQ("MST")=Y
- +19 QUIT
- VEH ;Vietnam-Era Herbicide Question
- +1 IF $GET(PSODFN)
- IF '$$AO^SDCO22(PSODFN)
- Begin DoDot:1
- +2 KILL PSOANSQ("VEH"),PSOANSQD("VEH")
- IF $GET(PSOX("IRXN"))
- KILL PSOANSQ(PSOX("IRXN"),"VEH")
- End DoDot:1
- QUIT
- +3 NEW PSOUFLAG
- SET PSOUFLAG=0
- +4 KILL DIR
- SET DIR(0)="Y"
- +5 SET DIR("A")="Was treatment related to Agent Orange exposure"
- +6 SET DIR("?")=" "
- SET DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition due to"
- SET DIR("?",2)="Vietnam-Era Herbicide (Agent Orange) exposure. This response will be used to"
- +7 SET DIR("?",3)="determine whether or not a copay should be applied to the prescription."
- +8 IF '$GET(PSOFLAG)
- SET (DIR("B"),PSOUFLAG)=$SELECT($GET(PSORX(+$GET(PSORENW("OIRXN")),"VEH"))=0:"NO",$GET(PSORX(+$GET(PSORENW("OIRXN")),"VEH"))=1:"YES",1:"")
- IF DIR("B")=""
- KILL DIR("B")
- SET PSOUFLAG=0
- +9 IF $GET(PSOFLAG)
- IF $GET(PSONEWFF)
- IF $GET(PSOANSQD("VEH"))=0!($GET(PSOANSQD("VEH"))=1)
- SET DIR("B")=$SELECT($GET(PSOANSQD("VEH"))=1:"YES",1:"NO")
- +10 WRITE !
- DO ^DIR
- KILL DIR
- +11 IF $GET(PSOFLAG)
- WRITE !
- Begin DoDot:1
- +12 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
- SET PSOCPZ("DFLG")=1
- QUIT
- +13 SET PSOANSQ("VEH")=Y
- +14 IF $GET(PSONEWFF)
- SET PSOANSQD("VEH")=Y
- End DoDot:1
- QUIT
- +15 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
- Begin DoDot:1
- +16 SET PSOANSQ(PSOX("IRXN"),"VEH")=$SELECT($GET(PSOUFLAG)="YES":1,1:0)
- End DoDot:1
- WRITE !!,"This Renewal has been designated as"_$SELECT($GET(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of Vietnam-Era",!,"Herbicide (Agent Orange) exposure."
- if $GET(PSOSCP)<50
- DO MESSV
- DO PAUSE
- QUIT
- +17 IF $GET(PSOX("IRXN"))
- SET PSOANSQ(PSOX("IRXN"),"VEH")=Y
- +18 IF '$TEST
- SET PSOANSQ("VEH")=Y
- +19 QUIT
- RAD ;Radiation question
- +1 IF $GET(PSODFN)
- IF '$$IR^SDCO22(PSODFN)
- Begin DoDot:1
- +2 KILL PSOANSQ("RAD"),PSOANSQD("RAD")
- IF $GET(PSOX("IRXN"))
- KILL PSOANSQ(PSOX("IRXN"),"RAD")
- End DoDot:1
- QUIT
- +3 NEW PSOUFLAG
- SET PSOUFLAG=0
- +4 KILL DIR
- SET DIR(0)="Y"
- +5 SET DIR("A")="Was treatment related to Ionizing Radiation exposure"
- +6 SET DIR("?")=" "
- SET DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition due to"
- SET DIR("?",2)="ionizing radiation exposure during military service. This response will be used"
- +7 SET DIR("?",3)="to determine whether or not a copay should be applied to the prescription."
- +8 IF '$GET(PSOFLAG)
- SET (DIR("B"),PSOUFLAG)=$SELECT($GET(PSORX(+$GET(PSORENW("OIRXN")),"RAD"))=0:"NO",$GET(PSORX(+$GET(PSORENW("OIRXN")),"RAD"))=1:"YES",1:"")
- IF DIR("B")=""
- KILL DIR("B")
- SET PSOUFLAG=0
- +9 IF $GET(PSOFLAG)
- IF $GET(PSONEWFF)
- IF $GET(PSOANSQD("RAD"))=0!($GET(PSOANSQD("RAD"))=1)
- SET DIR("B")=$SELECT($GET(PSOANSQD("RAD"))=1:"YES",1:"NO")
- +10 WRITE !
- DO ^DIR
- KILL DIR
- +11 IF $GET(PSOFLAG)
- WRITE !
- Begin DoDot:1
- +12 IF Y["^"!($DATA(DUOUT))!($GET(DTOUT))
- SET PSOCPZ("DFLG")=1
- QUIT
- +13 SET PSOANSQ("RAD")=Y
- +14 IF $GET(PSONEWFF)
- SET PSOANSQD("RAD")=Y
- End DoDot:1
- QUIT
- +15 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
- Begin DoDot:1
- +16 SET PSOANSQ(PSOX("IRXN"),"RAD")=$SELECT($GET(PSOUFLAG)="YES":1,1:0)
- End DoDot:1
- WRITE !!,"This Renewal has been designated as"_$SELECT($GET(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of ionizing",!,"radiation exposure."
- if $GET(PSOSCP)<50
- DO MESSM
- DO PAUSE
- QUIT
- +17 IF $GET(PSOX("IRXN"))
- SET PSOANSQ(PSOX("IRXN"),"RAD")=Y
- +18 IF '$TEST
- SET PSOANSQ("RAD")=Y
- +19 QUIT
- PGW ;Persian Gulf War question
- +1 IF $GET(PSODFN)
- IF '$$EC^SDCO22(PSODFN)
- Begin DoDot:1
- +2 KILL PSOANSQ("PGW"),PSOANSQD("PGW")
- IF $GET(PSOX("IRXN"))
- KILL PSOANSQ(PSOX("IRXN"),"PGW")
- End DoDot:1
- QUIT
- +3 NEW PSOUFLAG
- SET PSOUFLAG=0
- +4 KILL DIR
- SET DIR(0)="Y"
- +5 SET DIR("A")="Was treatment related to service in SW Asia"
- +6 SET DIR("?")=" "
- SET DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition related to"
- +7 SET DIR("?",2)="service in Southwest Asia. This response will be used to determine whether or"
- +8 SET DIR("?",3)="not a copay should be applied to the prescription."
- +9 IF '$GET(PSOFLAG)
- SET (DIR("B"),PSOUFLAG)=$SELECT($GET(PSORX(+$GET(PSORENW("OIRXN")),"PGW"))=0:"NO",$GET(PSORX(+$GET(PSORENW("OIRXN")),"PGW"))=1:"YES",1:"")
- IF DIR("B")=""
- KILL DIR("B")
- SET PSOUFLAG=0
- +10 IF $GET(PSOFLAG)
- IF $GET(PSONEWFF)
- IF $GET(PSOANSQD("PGW"))=0!($GET(PSOANSQD("PGW"))=1)
- SET DIR("B")=$SELECT($GET(PSOANSQD("PGW"))=1:"YES",1:"NO")
- +11 WRITE !
- DO ^DIR
- KILL DIR
- +12 IF $GET(PSOFLAG)
- WRITE !
- Begin DoDot:1
- +13 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
- SET PSOCPZ("DFLG")=1
- QUIT
- +14 SET PSOANSQ("PGW")=Y
- +15 IF $GET(PSONEWFF)
- SET PSOANSQD("PGW")=Y
- End DoDot:1
- QUIT
- +16 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
- Begin DoDot:1
- +17 SET PSOANSQ(PSOX("IRXN"),"PGW")=$SELECT($GET(PSOUFLAG)="YES":1,1:0)
- End DoDot:1
- WRITE !!,"This Renewal has been designated as"_$SELECT($GET(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of",!,"Southwest Asia Conditions exposure."
- if $GET(PSOSCP)<50
- DO MESS
- DO PAUSE
- QUIT
- +18 IF $GET(PSOX("IRXN"))
- SET PSOANSQ(PSOX("IRXN"),"PGW")=Y
- +19 IF '$TEST
- SET PSOANSQ("PGW")=Y
- +20 QUIT
- HNC ;Head or Neck Cancer question
- +1 IF $GET(PSODFN)
- IF $TEXT(GETCUR^DGNTAPI)]""
- NEW PSONCP,PSONCPX
- SET PSONCPX=$$GETCUR^DGNTAPI(PSODFN,"PSONCP")
- IF $PIECE($GET(PSONCP("IND")),"^")'="Y"
- Begin DoDot:1
- +2 KILL PSOANSQ("HNC"),PSOANSQD("HNC")
- IF $GET(PSOX("IRXN"))
- KILL PSOANSQ(PSOX("IRXN"),"HNC")
- End DoDot:1
- QUIT
- +3 NEW PSOUFLAG
- SET PSOUFLAG=0
- +4 KILL DIR
- SET DIR(0)="Y"
- +5 SET DIR("A")="Was treatment related to Head and/or Neck Cancer"
- +6 SET DIR("?")=" "
- SET DIR("?",1)="Enter 'Yes' if this prescription is being used to treat Head and/or Neck Cancer"
- SET DIR("?",2)="due to nose or throat radium treatments while in the military. This response"
- +7 SET DIR("?",3)="will be used to determine whether or not a copay should be applied to the"
- SET DIR("?",4)="prescription."
- +8 IF '$GET(PSOFLAG)
- SET (DIR("B"),PSOUFLAG)=$SELECT($GET(PSORX(+$GET(PSORENW("OIRXN")),"HNC"))=0:"NO",$GET(PSORX(+$GET(PSORENW("OIRXN")),"HNC"))=1:"YES",1:"")
- IF DIR("B")=""
- KILL DIR("B")
- SET PSOUFLAG=0
- +9 IF $GET(PSOFLAG)
- IF $GET(PSONEWFF)
- IF $GET(PSOANSQD("HNC"))=0!($GET(PSOANSQD("HNC"))=1)
- SET DIR("B")=$SELECT($GET(PSOANSQD("HNC"))=1:"YES",1:"NO")
- +10 WRITE !
- DO ^DIR
- KILL DIR
- +11 IF $GET(PSOFLAG)
- WRITE !
- Begin DoDot:1
- +12 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
- SET PSOCPZ("DFLG")=1
- QUIT
- +13 SET PSOANSQ("HNC")=Y
- +14 IF $GET(PSONEWFF)
- SET PSOANSQD("HNC")=Y
- End DoDot:1
- QUIT
- +15 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
- Begin DoDot:1
- +16 SET PSOANSQ(PSOX("IRXN"),"HNC")=$SELECT($GET(PSOUFLAG)="YES":1,1:0)
- End DoDot:1
- WRITE !!,"This Renewal has been designated as"_$SELECT($GET(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment related to",!,"Head and/or Neck Cancer."
- if $GET(PSOSCP)<50
- DO MESSV
- DO PAUSE
- QUIT
- +17 IF $GET(PSOX("IRXN"))
- SET PSOANSQ(PSOX("IRXN"),"HNC")=Y
- +18 IF '$TEST
- SET PSOANSQ("HNC")=Y
- +19 QUIT
- CV ; Combat Veteran Question
- +1 IF $GET(PSODFN)
- IF '(+$PIECE($$CVEDT^DGCV(PSODFN),"^",3))
- Begin DoDot:1
- +2 KILL PSOANSQ("CV"),PSOANSQD("CV")
- IF $GET(PSOX("IRXN"))
- KILL PSOANSQ(PSOX("IRXN"),"CV")
- End DoDot:1
- QUIT
- +3 NEW PSOUFLAG
- SET PSOUFLAG=0
- +4 KILL DIR
- SET DIR(0)="Y"
- +5 SET DIR("A")="Was treatment related to Combat"
- +6 SET DIR("?")=" "
- +7 SET DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition due to"
- +8 SET DIR("?",2)="active duty in a theater of combat operations during a period of war after the"
- +9 SET DIR("?",3)="Gulf War. This response will be used to determine whether or not a copay should"
- +10 SET DIR("?",4)="be applied to the prescription."
- +11 SET DIR("B")="YES"
- +12 IF '$GET(PSOFLAG)
- Begin DoDot:1
- +13 SET (DIR("B"),PSOUFLAG)=$SELECT($GET(PSORX(+$GET(PSORENW("OIRXN")),"CV"))=0:"NO",$GET(PSORX(+$GET(PSORENW("OIRXN")),"CV"))=1:"YES",1:"")
- +14 IF DIR("B")=""
- SET (PSOUFLAG,DIR("B"))="YES"
- End DoDot:1
- +15 IF $GET(PSOFLAG)
- IF $GET(PSONEWFF)
- Begin DoDot:1
- +16 IF $GET(PSOANSQD("CV"))=0!($GET(PSOANSQD("CV"))=1)
- Begin DoDot:2
- +17 SET DIR("B")=$SELECT($GET(PSOANSQD("CV"))=1:"YES",1:"NO")
- End DoDot:2
- End DoDot:1
- +18 WRITE !
- DO ^DIR
- KILL DIR
- +19 IF $GET(PSOFLAG)
- WRITE !
- Begin DoDot:1
- +20 IF Y["^"!($DATA(DUOUT))!($GET(DTOUT))
- SET PSOCPZ("DFLG")=1
- QUIT
- +21 SET PSOANSQ("CV")=Y
- +22 IF $GET(PSONEWFF)
- SET PSOANSQD("CV")=Y
- End DoDot:1
- QUIT
- +23 IF Y["^"!($DATA(DUOUT))!($DATA(DTOUT))
- Begin DoDot:1
- +24 WRITE !!,"This Renewal has been designated as"_$SELECT($GET(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of military"
- +25 WRITE !,"combat service."
- if $GET(PSOSCP)<50
- DO MESSM
- DO PAUSE
- +26 SET PSOANSQ(PSOX("IRXN"),"CV")=$SELECT($GET(PSOUFLAG)="YES":1,1:0)
- End DoDot:1
- QUIT
- +27 IF $GET(PSOX("IRXN"))
- SET PSOANSQ(PSOX("IRXN"),"CV")=Y
- +28 IF '$TEST
- SET PSOANSQ("CV")=Y
- +29 QUIT
- PAUSE ;
- +1 KILL DIR
- WRITE !
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- +2 QUIT
- MESS ;
- +1 if $GET(PSODRUG("DEA"))["S"!($GET(PSODRUG("DEA"))["I")!($GET(PSODRUG("DEA"))["N")
- QUIT
- +2 WRITE !,"Please use the 'Reset Copay Status/Cancel Charges' option to make corrections.",!
- +3 QUIT
- MESSM ;
- +1 if $GET(PSODRUG("DEA"))["S"!($GET(PSODRUG("DEA"))["I")!($GET(PSODRUG("DEA"))["N")
- QUIT
- +2 WRITE " Please use the 'Reset Copay Status/Cancel Charges' option",!,"to make corrections.",!
- +3 QUIT
- MESSV ;
- +1 if $GET(PSODRUG("DEA"))["S"!($GET(PSODRUG("DEA"))["I")!($GET(PSODRUG("DEA"))["N")
- QUIT
- +2 WRITE " Please use the 'Reset Copay Status/Cancel",!,"Charges' option to make corrections.",!