- 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/PSOCPC.m
r613 r623 1 PSOCPC ;BHAM ISC/BAB - PHARMACY CO-PAY APPLICATION ;06/09/92 2 ;;7.0;OUTPATIENT PHARMACY;**10,9,71,85,114,157,143,239,201,275,225**;DEC 1997;Build 29 3 ; 4 ;REF/IA 5 ;piece 9 of zero node of File 350 and APDT cross reference of File 350/2215 6 ;$$STATUS^IBARX/125 7 ;File 350.1/592 (DBIA125-B) 8 WARN ; Message when attempt is made to delete a refill date on COPAY 9 N PSOIB,PSOIBST 10 S PSOFLG=0 11 G:'$D(^PSRX(DA(1),1,DA,"IB")) ENDW 12 S PSOIB=^PSRX(DA(1),1,DA,"IB") 13 I +PSOIB'>0 G ENDW 14 S PSOIBST=$$STATUS^IBARX(+PSOIB) I PSOIBST=2!(PSOIBST=0) G ENDW 15 I +PSOIB>0 D CANCEL G ENDW:PSOFLG=0 16 I '$G(PSOXXDEL) D EN^DDIOL("This REFILL has COPAY charges, which MUST be removed","","$C(7),!!"),EN^DDIOL("BEFORE the refill date is deleted.","","!") 17 I '$G(PSOXXDEL) D EN^DDIOL("Use option RESET COPAY STATUS/CANCEL CHARGES, return to EDIT A PRESCRIPTION,","","!!"),EN^DDIOL("and delete the refill date.","","!"),EN^DDIOL(" ","","!!") 18 S PSOFLG=1 19 ENDW ; 20 I PSOFLG 21 K PSOFLG 22 Q 23 CANCEL ;Check if charge is cancelled for this Refill date 24 S PSOFLG=1 ;indicates a charge not cancelled 25 S PSOX=+^PSRX(DA(1),1,DA,"IB") 26 D LAST I PSOLAST'=PSOPARNT,$D(^IB(PSOLAST,0)),$P(^IBE(350.1,$P(^IB(PSOLAST,0),"^",3),0),"^",5)=2 S PSOFLG=0 27 K PSOLAST,PSOPARNT,PSOX,PSOL,PSOLDT 28 Q 29 LAST ;find last entry 30 S PSOLAST="" 31 S PSOPARNT=$P(^IB(+PSOX,0),"^",9) I 'PSOPARNT S PSOPARNT=+PSOX 32 S PSOLDT=$O(^IB("APDT",PSOPARNT,"")) I +PSOLDT F PSOL=0:0 S PSOL=$O(^IB("APDT",PSOPARNT,PSOLDT,PSOL)) Q:'PSOL S PSOLAST=PSOL 33 I PSOLAST="" S PSOLAST=PSOPARNT 34 Q 35 ; 36 EXEMCHK ; Allow reset of exemption answers 37 N PSOTG,PSOCPN,PSOEXMT,PSOANS,OLDIBQ,PSOSCP,PSOSCA 38 S PSOANS=0 D SCP^PSORN52D 39 S OLDIBQ=$G(^PSRX(PSODA,"IBQ")) 40 I OLDIBQ[0!(OLDIBQ)[1 D 41 . S PSOANS=1 42 . I $P(OLDIBQ,"^",1)'="" S PSOTG("SC")=$P(OLDIBQ,"^",1) 43 . I $P(OLDIBQ,"^",2)'="" S PSOTG("MST")=$P(OLDIBQ,"^",2) 44 . I $P(OLDIBQ,"^",3)'="" S PSOTG("AO")=$P(OLDIBQ,"^",3) 45 . I $P(OLDIBQ,"^",4)'="" S PSOTG("IR")=$P(OLDIBQ,"^",4) 46 . I $P(OLDIBQ,"^",5)'="" S PSOTG("EC")=$P(OLDIBQ,"^",5) 47 . I $P(OLDIBQ,"^",6)'="" S PSOTG("HNC")=$P(OLDIBQ,"^",6) 48 . I $P(OLDIBQ,"^",7)'="" S PSOTG("CV")=$P(OLDIBQ,"^",7) 49 . I $P(OLDIBQ,"^",8)'="" S PSOTG("SHAD")=$P(OLDIBQ,"^",8) 50 S PSOCPN=$P(^PSRX(PSODA,0),"^",2) 51 S RXP=PSODA 52 D SCNEW^PSOCP(.PSOTG,PSOCPN,"",PSODA) 53 N EXMT 54 D XTYPE^PSOCP ; KEEP THIS CALL IN HERE TO SEE IF SC QUESTION APPLIES 55 ;I $D(PSOTG("SC")) S PSOTG("SC")=$P(OLDIBQ,"^",1) ; CHANGED TO JUST USE IBQ SETTING IF SC QUESTION APPLIES - DON'T RE-CALCULATE SERVICE-CONNECTED 56 S EXMT="" F S EXMT=$O(PSOTG(EXMT)) Q:EXMT="" I PSOTG(EXMT)'="" S PSOANS=1 Q 57 I $O(PSOTG(""))="" Q 58 I PSOANS W !!,"The following exemption flags have been set:" 59 F EXMT="SC","CV","AO","IR","EC","SHAD","MST","HNC" I $G(PSOTG(EXMT))'="" W !,$S(EXMT="EC":"SWAC",1:EXMT),": ",?6,$S(PSOTG(EXMT)=1:"Yes",PSOTG(EXMT)=0:"No",1:"") 60 W ! 61 W ! K DIR S DIR(0)="Y",DIR("B")="N" D S DIR("A")="Do you want to enter/edit any copay exemption flags" 62 . S EXMT="" F S EXMT=$O(PSOTG(EXMT)) Q:EXMT="" I PSOTG(EXMT)="" S DIR("B")="Y" Q 63 S DIR("?")="Enter 'Y' for Yes if you want to edit any applicable medication exemption flags." 64 S DIR("??")="^D HELPEXEM^PSOCPC" 65 D ^DIR K DIR S PSOEXMT=Y I Y'=1 Q 66 ; PRESENT ALL APPLICABLE EXEMPTIONS AND SAVE NEW ANSWERS 67 N PSOIBQ,PSOSUBS,PSOQUES,PSOLTAG,OLDIBQ,II,PSOCHG,PSOPATST 68 S PSOPATST=$$GET1^DIQ(52,PSODA_",",3,"I") 69 S PSOIBQ="" 70 S OLDIBQ=$G(^PSRX(PSODA,"IBQ")) 71 I '$D(^PSRX(PSODA,"IBQ")),+($G(^PSRX(PSODA,"IB")))=2 S $P(OLDIBQ,"^",1)=0 ; SC QUESTION WAS PREVIOUSLY ANSWERED AS N 72 S PSOCOMM="",PSOOLD="",PSONW="" 73 S II=0 74 F EXMT="SC","CV","AO","IR","EC","SHAD","MST","HNC" I $D(PSOTG(EXMT)) D 75 . S PSOLTAG="REL"_EXMT_"^PSOCPE" 76 . S HELPTAG="HELP"_EXMT 77 . S PSOQUES=$P($T(@PSOLTAG),";",2) I PSOQUES="" Q 78 . S PSOQUES=$P(PSOQUES,"?") 79 . S PSOSUBS=$P($T(@PSOLTAG),";",3) I PSOSUBS="" Q 80 . D ASKEXEM 81 I $D(PSOCHG) D 82 . ;PSO*7*275 IBQ node should not be present in some cases. 83 . K ^PSRX(PSODA,"IBQ") 84 . S:PSOSCP<50&($TR(PSOIBQ,"^")'="")&($P($G(^PS(53,+$G(PSOPATST),0)),"^",7)'=1) ^PSRX(PSODA,"IBQ")=PSOIBQ 85 . D RESET^PSORN52D ;set SC/EI on ICD node 86 . S PSOPFSA=1 ;PFSS-denotes to calling routine that outpatient classifications changed. 87 . D EN^PSOHLSN1(PSODA,"XX","","Order edited") 88 . I PCOPAY,PSOIBQ["1" D ; RESET TO NO COPAY 89 . . W !,"Editing of exemption flag(s) has resulted in a copay status change.",!,"The status for this Rx will be reset to NO COPAY." 90 . . S $P(^PSRX(PSODA,"IB"),"^",1)="" 91 . . S PSOREF="",PSOOLD="Copay",PSONW="No Copay",PREA="R" D ACTLOG^PSOCPA 92 . . S PSOCOMM="Copay status reset due to exemption flag(s)" 93 . . S PSI=0 D SETSUMM 94 . I $G(II)>0 D 95 . . S PSOCOMM="The following exemption flags have been changed: ",PSI=0 D SETSUMM 96 . . S II="" F S II=$O(PSOCHG(II)) Q:II="" S PSOCOMM=PSOCHG(II),PSI=0 D SETSUMM 97 Q 98 ; 99 ASKEXEM ; ASK THE EXEMPTION QUESTIONS 100 K DIR S DIR("A")=PSOQUES,DIR(0)="YO" S:PSOTG(EXMT)=1 DIR("B")="Y" S:PSOTG(EXMT)=0 DIR("B")="N" D @HELPTAG 101 ASKEXEM1 D ^DIR I X="@" R !," Are you sure you want to delete this answer? ",X:DTIME I $E(X)'="Y",$E(X)'="y" G ASKEXEM1 102 I X="^" S X=$G(DIR("B")) S Y=$S(X="Y":1,X="N":0,1:"") 103 S $P(PSOIBQ,"^",PSOSUBS)=$S(Y=1:1,Y=0:0,1:"") 104 I $P(PSOIBQ,"^",PSOSUBS)'=$P(OLDIBQ,"^",PSOSUBS) S II=II+1,PSOCHG(II)=$S(EXMT="EC":"SWAC",1:EXMT)_": "_$S($P(PSOIBQ,"^",PSOSUBS)=1:"Yes",$P(PSOIBQ,"^",PSOSUBS)=0:"No",1:"") 105 I Y=1 D 106 . I PSOCOMM'="" Q 107 . D SETCOMM^PSOCP 108 Q 109 ; 110 HELPEXEM ; help text for exemption edit question 111 W !,"Enter 'Y' for Yes if you want to edit any applicable exemption flags such as" 112 W !,"Service Connected (SC), Combat Veteran(CV), Agent Orange (AO), Ionizing" 113 W !,"Radiation (IR), Southwest Asia Conditions (SWAC), PROJ 112/SHAD," 114 W !,"Military Sexual Trauma (MST), or Head and/or Neck Cancer (HNC)." 115 Q 116 ; 117 HELPSC ; 118 S DIR("?")=" ",DIR("?",1)="Enter 'Yes' if this prescription is for a Service Connected condition." 119 S DIR("?",2)="This response will be used to determine whether or not a copay should be" 120 S DIR("?",3)="applied to the prescription." 121 Q 122 ; 123 HELPAO ; 124 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" 125 S DIR("?",3)="determine whether or not a copay should be applied to the prescription." 126 Q 127 ; 128 HELPIR ; 129 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" 130 S DIR("?",3)="to determine whether or not a copay should be applied to the prescription." 131 Q 132 ; 133 HELPEC ; 134 S DIR("?")=" ",DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition related to",DIR("?",2)="service in Southwest Asia. This response will be used to determine whether" 135 S DIR("?",3)="or not a copay should be applied to the prescription." 136 Q 137 ; 138 HELPMST ; 139 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" 140 S DIR("?",3)="not a copay should be applied to the prescription." 141 Q 142 ; 143 HELPHNC ; 144 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" 145 S DIR("?",3)="will be used to determine whether or not a copay should be applied to the",DIR("?",4)="prescription." 146 Q 147 ; 148 HELPCV ; 149 S DIR("?")=" " 150 S DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition related" 151 S DIR("?",2)="to Combat Services. This response will be used to determine whether or" 152 S DIR("?",3)="not a copay should be applied to the prescription." 153 Q 154 ; 155 HELPSHAD ; 156 S DIR("?")=" " 157 S DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition related" 158 S DIR("?",2)="to PROJ 112/SHAD. This response will be used to determine whether or" 159 S DIR("?",3)="not a copay should be applied to the prescription." 160 Q 161 SETSUMM ; SET MESSAGE INTO SUMMARY 162 S PSI=$O(PSOSUMM(PSI)) G:$O(PSOSUMM(PSI)) SETSUMM 163 S PSI=PSI+1,PSOSUMM(PSI)=PSOCOMM 164 K PSOCOMM 165 Q 166 ; 1 PSOCPC ;BHAM ISC/BAB - PHARMACY CO-PAY APPLICATION ;06/09/92 2 ;;7.0;OUTPATIENT PHARMACY;**10,9,71,85,114,157,143,239,201**;DEC 1997 3 ; 4 ;REF/IA 5 ;piece 9 of zero node of File 350 and APDT cross reference of File 350/2215 6 ;$$STATUS^IBARX/125 7 ;File 350.1/592 (DBIA125-B) 8 WARN ; Message when attempt is made to delete a refill date on COPAY 9 N PSOIB,PSOIBST 10 S PSOFLG=0 11 G:'$D(^PSRX(DA(1),1,DA,"IB")) ENDW 12 S PSOIB=^PSRX(DA(1),1,DA,"IB") 13 I +PSOIB'>0 G ENDW 14 S PSOIBST=$$STATUS^IBARX(+PSOIB) I PSOIBST=2!(PSOIBST=0) G ENDW 15 I +PSOIB>0 D CANCEL G ENDW:PSOFLG=0 16 I '$G(PSOXXDEL) D EN^DDIOL("This REFILL has COPAY charges, which MUST be removed","","$C(7),!!"),EN^DDIOL("BEFORE the refill date is deleted.","","!") 17 I '$G(PSOXXDEL) D EN^DDIOL("Use option RESET COPAY STATUS/CANCEL CHARGES, return to EDIT A PRESCRIPTION,","","!!"),EN^DDIOL("and delete the refill date.","","!"),EN^DDIOL(" ","","!!") 18 S PSOFLG=1 19 ENDW ; 20 I PSOFLG 21 K PSOFLG 22 Q 23 CANCEL ;Check if charge is cancelled for this Refill date 24 S PSOFLG=1 ;indicates a charge not cancelled 25 S PSOX=+^PSRX(DA(1),1,DA,"IB") 26 D LAST I PSOLAST'=PSOPARNT,$D(^IB(PSOLAST,0)),$P(^IBE(350.1,$P(^IB(PSOLAST,0),"^",3),0),"^",5)=2 S PSOFLG=0 27 K PSOLAST,PSOPARNT,PSOX,PSOL,PSOLDT 28 Q 29 LAST ;find last entry 30 S PSOLAST="" 31 S PSOPARNT=$P(^IB(+PSOX,0),"^",9) I 'PSOPARNT S PSOPARNT=+PSOX 32 S PSOLDT=$O(^IB("APDT",PSOPARNT,"")) I +PSOLDT F PSOL=0:0 S PSOL=$O(^IB("APDT",PSOPARNT,PSOLDT,PSOL)) Q:'PSOL S PSOLAST=PSOL 33 I PSOLAST="" S PSOLAST=PSOPARNT 34 Q 35 ; 36 EXEMCHK ; Allow reset of exemption answers 37 N PSOTG,PSOCPN,PSOEXMT,PSOANS,OLDIBQ,PSOSCP,PSOSCA 38 S PSOANS=0 D SCP^PSORN52D 39 S OLDIBQ=$G(^PSRX(PSODA,"IBQ")) 40 I OLDIBQ[0!(OLDIBQ)[1 D 41 . S PSOANS=1 42 . I $P(OLDIBQ,"^",1)'="" S PSOTG("SC")=$P(OLDIBQ,"^",1) 43 . I $P(OLDIBQ,"^",2)'="" S PSOTG("MST")=$P(OLDIBQ,"^",2) 44 . I $P(OLDIBQ,"^",3)'="" S PSOTG("AO")=$P(OLDIBQ,"^",3) 45 . I $P(OLDIBQ,"^",4)'="" S PSOTG("IR")=$P(OLDIBQ,"^",4) 46 . I $P(OLDIBQ,"^",5)'="" S PSOTG("EC")=$P(OLDIBQ,"^",5) 47 . I $P(OLDIBQ,"^",6)'="" S PSOTG("HNC")=$P(OLDIBQ,"^",6) 48 . I $P(OLDIBQ,"^",7)'="" S PSOTG("CV")=$P(OLDIBQ,"^",7) 49 S PSOCPN=$P(^PSRX(PSODA,0),"^",2) 50 S RXP=PSODA 51 D SCNEW^PSOCP(.PSOTG,PSOCPN,"",PSODA) 52 N EXMT 53 D XTYPE^PSOCP ; KEEP THIS CALL IN HERE TO SEE IF SC QUESTION APPLIES 54 ;I $D(PSOTG("SC")) S PSOTG("SC")=$P(OLDIBQ,"^",1) ; CHANGED TO JUST USE IBQ SETTING IF SC QUESTION APPLIES - DON'T RE-CALCULATE SERVICE-CONNECTED 55 S EXMT="" F S EXMT=$O(PSOTG(EXMT)) Q:EXMT="" I PSOTG(EXMT)'="" S PSOANS=1 Q 56 I $O(PSOTG(""))="" Q 57 I PSOANS W !!,"The following exemption flags have been set:" 58 F EXMT="SC","CV","AO","IR","EC","MST","HNC" I $G(PSOTG(EXMT))'="" W !,EXMT,": ",?6,$S(PSOTG(EXMT)=1:"Yes",PSOTG(EXMT)=0:"No",1:"") 59 W ! 60 W ! K DIR S DIR(0)="Y",DIR("B")="N" D S DIR("A")="Do you want to enter/edit any copay exemption flags" 61 . S EXMT="" F S EXMT=$O(PSOTG(EXMT)) Q:EXMT="" I PSOTG(EXMT)="" S DIR("B")="Y" Q 62 S DIR("?")="Enter 'Y' for Yes if you want to edit any applicable medication exemption flags." 63 S DIR("??")="^D HELPEXEM^PSOCPC" 64 D ^DIR K DIR S PSOEXMT=Y I Y'=1 Q 65 ; PRESENT ALL APPLICABLE EXEMPTIONS AND SAVE NEW ANSWERS 66 N PSOIBQ,PSOSUBS,PSOQUES,PSOLTAG,OLDIBQ,II,PSOCHG,PSOPATST 67 S PSOPATST=$$GET1^DIQ(52,PSODA_",",3,"I") 68 S PSOIBQ="" 69 S OLDIBQ=$G(^PSRX(PSODA,"IBQ")) 70 I '$D(^PSRX(PSODA,"IBQ")),+($G(^PSRX(PSODA,"IB")))=2 S $P(OLDIBQ,"^",1)=0 ; SC QUESTION WAS PREVIOUSLY ANSWERED AS N 71 S PSOCOMM="",PSOOLD="",PSONW="" 72 S II=0 73 F EXMT="SC","CV","AO","IR","EC","MST","HNC" I $D(PSOTG(EXMT)) D 74 . S PSOLTAG="REL"_EXMT_"^PSOCPE" 75 . S HELPTAG="HELP"_EXMT 76 . S PSOQUES=$P($T(@PSOLTAG),";",2) I PSOQUES="" Q 77 . S PSOQUES=$P(PSOQUES,"?") 78 . S PSOSUBS=$P($T(@PSOLTAG),";",3) I PSOSUBS="" Q 79 . D ASKEXEM 80 I $D(PSOCHG) D 81 . S:PSOSCP<50&($TR(PSOIBQ,"^")'="")&($P($G(^PS(53,+$G(PSOPATST),0)),"^",7)'=1) ^PSRX(PSODA,"IBQ")=PSOIBQ 82 . D RESET^PSORN52D ;set SC/EI on ICD node 83 . S PSOPFSA=1 ;PFSS-denotes to calling routine that outpatient classifications changed. 84 . D EN^PSOHLSN1(PSODA,"XX","","Order edited") 85 . I PCOPAY,PSOIBQ["1" D ; RESET TO NO COPAY 86 . . W !,"Editing of exemption flag(s) has resulted in a copay status change.",!,"The status for this Rx will be reset to NO COPAY." 87 . . S $P(^PSRX(PSODA,"IB"),"^",1)="" 88 . . S PSOREF="",PSOOLD="Copay",PSONW="No Copay",PREA="R" D ACTLOG^PSOCPA 89 . . S PSOCOMM="Copay status reset due to exemption flag(s)" 90 . . S PSI=0 D SETSUMM 91 . I $G(II)>0 D 92 . . S PSOCOMM="The following exemption flags have been changed: ",PSI=0 D SETSUMM 93 . . S II="" F S II=$O(PSOCHG(II)) Q:II="" S PSOCOMM=PSOCHG(II),PSI=0 D SETSUMM 94 Q 95 ; 96 ASKEXEM ; ASK THE EXEMPTION QUESTIONS 97 K DIR S DIR("A")=PSOQUES,DIR(0)="YO" S:PSOTG(EXMT)=1 DIR("B")="Y" S:PSOTG(EXMT)=0 DIR("B")="N" D @HELPTAG 98 ASKEXEM1 D ^DIR I X="@" R !," Are you sure you want to delete this answer? ",X:DTIME I $E(X)'="Y",$E(X)'="y" G ASKEXEM1 99 I X="^" S X=$G(DIR("B")) S Y=$S(X="Y":1,X="N":0,1:"") 100 S $P(PSOIBQ,"^",PSOSUBS)=$S(Y=1:1,Y=0:0,1:"") 101 I $P(PSOIBQ,"^",PSOSUBS)'=$P(OLDIBQ,"^",PSOSUBS) S II=II+1,PSOCHG(II)=EXMT_": "_$S($P(PSOIBQ,"^",PSOSUBS)=1:"Yes",$P(PSOIBQ,"^",PSOSUBS)=0:"No",1:"") 102 I Y=1 D 103 . I PSOCOMM'="" Q 104 . D SETCOMM^PSOCP 105 Q 106 ; 107 HELPEXEM ; help text for exemption edit question 108 W !,"Enter 'Y' for Yes if you want to edit any applicable exemption flags such as" 109 W !,"Service Connected (SC), Combat Veteran(CV), Agent Orange (AO), Ionizing Radiation (IR)," 110 W !,"Environmental Contaminants (EC), Military Sexual Trauma (MST), or" 111 W !,"Head and/or Neck Cancer (HNC)." 112 Q 113 ; 114 HELPSC ; 115 S DIR("?")=" ",DIR("?",1)="Enter 'Yes' if this prescription is for a Service Connected condition." 116 S DIR("?",2)="This response will be used to determine whether or not a copay should be" 117 S DIR("?",3)="applied to the prescription." 118 Q 119 ; 120 HELPAO ; 121 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" 122 S DIR("?",3)="determine whether or not a copay should be applied to the prescription." 123 Q 124 ; 125 HELPIR ; 126 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" 127 S DIR("?",3)="to determine whether or not a copay should be applied to the prescription." 128 Q 129 ; 130 HELPEC ; 131 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" 132 S DIR("?",3)="will be used to determine whether or not a copay should be applied to the",DIR("?",4)="prescription." 133 Q 134 ; 135 HELPMST ; 136 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" 137 S DIR("?",3)="not a copay should be applied to the prescription." 138 Q 139 ; 140 HELPHNC ; 141 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" 142 S DIR("?",3)="will be used to determine whether or not a copay should be applied to the",DIR("?",4)="prescription." 143 Q 144 ; 145 HELPCV ; 146 S DIR("?")=" " 147 S DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition related" 148 S DIR("?",2)="to Combat Services. This response will be used to determine whether or" 149 S DIR("?",3)="not a copay should be applied to the prescription." 150 Q 151 ; 152 SETSUMM ; SET MESSAGE INTO SUMMARY 153 S PSI=$O(PSOSUMM(PSI)) G:$O(PSOSUMM(PSI)) SETSUMM 154 S PSI=PSI+1,PSOSUMM(PSI)=PSOCOMM 155 K PSOCOMM 156 Q 157 ;
Note:
See TracChangeset
for help on using the changeset viewer.
