- 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/PSONEWF.m
r613 r623 1 PSONEWF ;BIR/RTR - Copay finish questions ;07/26/96 2 ;;7.0;OUTPATIENT PHARMACY;**71,157,143,219,226,239,225**;DEC 1997;Build 29 3 ;External reference VADPT supported by DBIA 10061 4 START ; 5 N PSOPENIB,PSOSCOTH,PSOSCOTX,PSOMESFI 6 S PSOPENIB=$S($G(ORD):$G(^PS(52.41,+$G(ORD),"IBQ")),1:"") 7 ;set PSOSCOTH for display of Provider Copay intent, used with PSORX(SC) 8 S PSOSCOTH=0 I $P(PSOPENIB,"^")=1!($P(PSOPENIB,"^",2)=1)!($P(PSOPENIB,"^",3)=1)!($P(PSOPENIB,"^",4)=1)!($P(PSOPENIB,"^",5)=1)!($P(PSOPENIB,"^",6)=1)!($P(PSOPENIB,"^",7)=1) S PSOSCOTH=1 9 S PSOSCOTX=0 I $G(PSOSCOTH)!($G(PSORX("SC"))="SC")!($G(PSORX("SC"))="NSC") S PSOSCOTX=1 10 ;Check for Orderable Item change to display message 11 S PSOMESFI=0 I $G(OR0),$G(PSODRUG("OI")) D 12 .I $G(PSODRUG("OI"))'=$P($G(OR0),"^",8) S PSOMESFI=1 13 S PSONEWFF=1,PSOFLAG=1 14 ;Copay exemption checks 15 D SCP^PSORN52D 16 K PSOANSQ D SET S PSOCPZ("DFLG")=0,PSONEW("NEWCOPAY")=0 17 I (PSOSCP<50)&($P($G(^PS(53,+$G(PSONEW("PATIENT STATUS")),0)),"^",7)'=1),$G(DUZ("AG"))="V" D COPAY^PSOCPB W ! 18 I $G(PSOCPZ("DFLG")) K PSONEW("NEWCOPAY"),PSONEWFF,PSOSCOTH,PSOSCOTX,PSOMESFI Q 19 I PSOSCA&(PSOSCP>49)!((PSOSCA!(PSOBILL=2))&($P($G(^PS(53,+$G(PSONEW("PATIENT STATUS")),0)),"^",7)=1))!(PSOSCP>49&(PSOBILL=2)) D I $G(PSOCPZ("DFLG")) K PSOANSQ,PSONEW("NEWCOPAY"),PSONEWFF,PSOSCOTH,PSOSCOTX,PSOMESFI Q 20 . I PSOSCP<50 D MESS S:PSOSCP<50 PSOANSQD("SC>50")=$G(PSOANSQD("SC")) 21 . D SC^PSOMLLD2 22 . I PSOSCP<50&($D(PSOANSQD("SC"))) S PSOANSQD("SC")=PSOANSQD("SC>50") K PSOANSQD("SC") 23 ;IF MILL BILL, AND COPAY (*******TEST THE COPAY CHECK) 24 I $$DT^PSOMLLDT D I $G(PSOCPZ("DFLG")) K PSOANSQ,PSONEW("NEWCOPAY"),PSONEWFF,PSOSCOTH,PSOSCOTX,PSOMESFI Q 25 .;New prompts Quit after first '^' 26 .I $D(PSOIBQS(PSODFN,"CV")) D D MESSOI,MESS D CV^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("CV"))) K PSONEW("NEWCOPAY") 27 ..I '$D(PSOANSQD("CV")),($P(PSOPENIB,"^",6)=0!($P(PSOPENIB,"^",6)=1)) S PSOANSQD("CV")=$P(PSOPENIB,"^",6) 28 .I $D(PSOIBQS(PSODFN,"VEH")) D D MESSOI,MESS D VEH^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("VEH"))) K PSONEW("NEWCOPAY") 29 ..I '$D(PSOANSQD("VEH")),($P(PSOPENIB,"^",2)=0!($P(PSOPENIB,"^",2)=1)) S PSOANSQD("VEH")=$P(PSOPENIB,"^",2) 30 .I $D(PSOIBQS(PSODFN,"RAD")) D D MESSOI,MESS D RAD^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("RAD"))) K PSONEW("NEWCOPAY") 31 ..I '$D(PSOANSQD("RAD")),($P(PSOPENIB,"^",3)=0!($P(PSOPENIB,"^",3)=1)) S PSOANSQD("RAD")=$P(PSOPENIB,"^",3) 32 .I $D(PSOIBQS(PSODFN,"PGW")) D D MESSOI,MESS D PGW^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("PGW"))) K PSONEW("NEWCOPAY") 33 ..I '$D(PSOANSQD("PGW")),($P(PSOPENIB,"^",4)=0!($P(PSOPENIB,"^",4)=1)) S PSOANSQD("PGW")=$P(PSOPENIB,"^",4) 34 .I $D(PSOIBQS(PSODFN,"SHAD")) D D MESSOI,MESS D SHAD^PSOMLLD2 I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("SHAD"))) K PSONEW("NEWCOPAY") 35 ..I '$D(PSOANSQD("SHAD")),($P(PSOPENIB,"^",7)=0!($P(PSOPENIB,"^",7)=1)) S PSOANSQD("SHAD")=$P(PSOPENIB,"^",7) 36 .I $D(PSOIBQS(PSODFN,"MST")) D D MESSOI,MESS D MST^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("MST"))) K PSONEW("NEWCOPAY") 37 ..I '$D(PSOANSQD("MST")),($P(PSOPENIB,"^")=0!($P(PSOPENIB,"^")=1)) S PSOANSQD("MST")=$P(PSOPENIB,"^") 38 .I $D(PSOIBQS(PSODFN,"HNC")) D D MESSOI,MESS D HNC^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("HNC"))) K PSONEW("NEWCOPAY") 39 ..I '$D(PSOANSQD("HNC")),($P(PSOPENIB,"^",5)=0!($P(PSOPENIB,"^",5)=1)) S PSOANSQD("HNC")=$P(PSOPENIB,"^",5) 40 K PSONEWFF,PSOSCOTH,PSOSCOTX,PSOMESFI,PSOSCA 41 Q 42 SET ;Set original answers that were passed from CPRS 43 Q:'$G(ORD) 44 Q:'$G(PSOFDR) 45 I $P($G(^PS(52.41,ORD,0)),"^",16)="SC"!($P($G(^(0)),"^",16)="NSC") D 46 . I PSOSCP<50 S PSOANSQ("SC")=$S($P($G(^(0)),"^",16)="SC":1,1:0),PSOANSQD("SC")=PSOANSQ("SC") S:PSOANSQ("SC")'="" PSOIBQS(PSODFN,"SC")=PSOANSQ("SC") 47 . I PSOSCP>49 S PSOANSQ("SC>50")=$S($P($G(^(0)),"^",16)="SC":1,1:0),PSOANSQD("SC>50")=PSOANSQ("SC>50") S:PSOANSQ("SC>50")'="" PSOIBQS(PSODFN,"SC>50")=PSOANSQ("SC>50") 48 I $G(PSOPENIB)="" G SET2 49 I '$$DT^PSOMLLDT Q 50 I $P(PSOPENIB,"^")=0!($P(PSOPENIB,"^")=1) S PSOANSQ("MST")=$P(PSOPENIB,"^") 51 I $P(PSOPENIB,"^",2)=0!($P(PSOPENIB,"^",2)=1) S PSOANSQ("VEH")=$P(PSOPENIB,"^",2) 52 I $P(PSOPENIB,"^",3)=0!($P(PSOPENIB,"^",3)=1) S PSOANSQ("RAD")=$P(PSOPENIB,"^",3) 53 I $P(PSOPENIB,"^",4)=0!($P(PSOPENIB,"^",4)=1) S PSOANSQ("PGW")=$P(PSOPENIB,"^",4) 54 I $P(PSOPENIB,"^",5)=0!($P(PSOPENIB,"^",5)=1) S PSOANSQ("HNC")=$P(PSOPENIB,"^",5) 55 I $P(PSOPENIB,"^",6)=0!($P(PSOPENIB,"^",6)=1) S PSOANSQ("CV")=$P(PSOPENIB,"^",6) 56 I $P(PSOPENIB,"^",7)=0!($P(PSOPENIB,"^",7)=1) S PSOANSQ("SHAD")=$P(PSOPENIB,"^",7) 57 ; 58 SET2 ;for when patient status is exempt, null IBQ node was set for exempts or SC>50 - data is in ICD node 59 N PSOOICD 60 I $TR($G(^PS(52.41,+$G(ORD),"IBQ")),"^")="" S PSOOICD=$G(^PS(52.41,ORD,"ICD",1,0)) D SET3:PSOOICD'="" 61 ; 62 ICD1 ; 63 N PSONOCHG S PSONOCHG=0 64 I ('$D(PSORXED("ICD"))) S PSONOCHG=1 65 I $D(^PS(52.41,ORD,"ICD",0)) D 66 . N JJ,ICD,II,FLD,RXN S RXN=ORD 67 . S II=0 F S II=$O(^PS(52.41,ORD,"ICD",II)) Q:II=""!(II'?1N.N) D 68 .. S ICD=^PS(52.41,ORD,"ICD",II,0),FLD=$P(ICD,U) S:$G(PSONEW("IDFLG")) FLD="" D ICD 69 Q 70 ; 71 SET3 ; called from PSONEWF and PSONEWG; must have PSOOICD. For SC>50, exempt patient status, etc. 72 N JJJ 73 F JJJ=2:1:9 I $P(PSOOICD,"^",JJJ)=0!($P(PSOOICD,"^",JJJ)=1) D 74 . I JJJ=2 S (PSOANSQD("VEH"),PSOANSQ("VEH"))=$P(PSOOICD,"^",JJJ) 75 . I JJJ=3 S (PSOANSQD("RAD"),PSOANSQ("RAD"))=$P(PSOOICD,"^",JJJ) 76 . I JJJ=4 D 77 .. S:PSOSCP<50 (PSOANSQD("SC"),PSOANSQ("SC"))=$P(PSOOICD,"^",JJJ) 78 .. S:PSOSCP>49!($P($G(^PS(53,+$G(PSONEW("PATIENT STATUS")),0)),"^",7)=1) (PSOANSQD("SC>50"),PSOANSQ("SC>50"))=$P(PSOOICD,"^",JJJ) 79 . I JJJ=5 S (PSOANSQD("PGW"),PSOANSQ("PGW"))=$P(PSOOICD,"^",JJJ) 80 . I JJJ=6 S (PSOANSQD("MST"),PSOANSQ("MST"))=$P(PSOOICD,"^",JJJ) 81 . I JJJ=7 S (PSOANSQD("HNC"),PSOANSQ("HNC"))=$P(PSOOICD,"^",JJJ) 82 . I JJJ=8 S (PSOANSQD("CV"),PSOANSQ("CV"))=$P(PSOOICD,"^",JJJ) 83 . I JJJ=9 S (PSOANSQD("SHAD"),PSOANSQ("SHAD"))=$P(PSOOICD,"^",JJJ) 84 K PSOOICD 85 Q 86 MESS ; 87 I $G(PSOSCOTX)=1&(PSOSCP<50) W:$G(PSODRUG("DEA"))'["S"&($G(PSODRUG("DEA"))'["I") !,"This Rx has been flagged by the provider as: "_$S($G(PSOSCOTH):"NO COPAY",$G(PSORX("SC"))="SC":"NO COPAY",1:"COPAY"),! S PSOSCOTX=2 88 Q 89 MESSOI ; 90 I $G(PSOMESFI)=1 W !!,"The Pharmacy Orderable Item has changed for this order. Please review any",!,"existing SC or Environmental Indicator defaults carefully for appropriateness.",! S PSOMESFI=2 91 Q 92 ; 93 ICD ;called from PSONEWG,PSORENW1 and used by PSONEWF 94 I $G(PSOCOPY)&($D(PSORXED("ICD")))&($D(PSONEW("IDFLG"))) Q:'$D(PSORXED("ICD",II)) 95 I $G(PSOCOPY)&($D(PSORXED("ICD",II))) S PSONEW("ICD",II)=PSORXED("ICD",II) Q 96 Q:'$G(PSOCOPY)&('$D(PSORXED("ICD",II)))&('$G(PSONOCHG)) ;don't set deleted ones 97 Q:$G(PSONEW("IDFLG")) 98 I $D(PSORX("ICD",II)) S PSONEW("ICD",II)=PSORX("ICD",II) Q 99 S PSONEW("ICD",II)=FLD 100 Q 101 ; 1 PSONEWF ;BIR/RTR - Copay finish questions ;07/26/96 2 ;;7.0;OUTPATIENT PHARMACY;**71,157,143,219,226,239,208**;DEC 1997;Build 39 3 ; Modified from FOIA VISTA, 4 ; Copyright (C) 2007 WorldVistA 5 ; 6 ; This program is free software; you can redistribute it and/or modify 7 ; it under the terms of the GNU General Public License as published by 8 ; the Free Software Foundation; either version 2 of the License, or 9 ; (at your option) any later version. 10 ; 11 ; This program is distributed in the hope that it will be useful, 12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of 13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 ; GNU General Public License for more details. 15 ; 16 ; You should have received a copy of the GNU General Public License 17 ; along with this program; if not, write to the Free Software 18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 19 ;External reference VADPT supported by DBIA 10061 20 START ; 21 I $G(PSOAFYN)="Y" Q ; vfam 22 N PSOPENIB,PSOSCOTH,PSOSCOTX,PSOMESFI 23 S PSOPENIB=$S($G(ORD):$G(^PS(52.41,+$G(ORD),"IBQ")),1:"") 24 ;set PSOSCOTH for display of Provider Copay intent, used with PSORX(SC) 25 S PSOSCOTH=0 I $P(PSOPENIB,"^")=1!($P(PSOPENIB,"^",2)=1)!($P(PSOPENIB,"^",3)=1)!($P(PSOPENIB,"^",4)=1)!($P(PSOPENIB,"^",5)=1)!($P(PSOPENIB,"^",6)=1) S PSOSCOTH=1 26 S PSOSCOTX=0 I $G(PSOSCOTH)!($G(PSORX("SC"))="SC")!($G(PSORX("SC"))="NSC") S PSOSCOTX=1 27 ;Check for Orderable Item change to display message 28 S PSOMESFI=0 I $G(OR0),$G(PSODRUG("OI")) D 29 .I $G(PSODRUG("OI"))'=$P($G(OR0),"^",8) S PSOMESFI=1 30 S PSONEWFF=1,PSOFLAG=1 31 ;Copay exemption checks 32 D SCP^PSORN52D 33 K PSOANSQ D SET S PSOCPZ("DFLG")=0,PSONEW("NEWCOPAY")=0 34 I (PSOSCP<50)&($P($G(^PS(53,+$G(PSONEW("PATIENT STATUS")),0)),"^",7)'=1),$G(DUZ("AG"))="V" D COPAY^PSOCPB W ! 35 I $P(PSOPENIB,"^",6)=0!($P(PSOPENIB,"^",6)=1) S PSOANSQ("CV")=$P(PSOPENIB,"^",6) 36 I $G(PSOCPZ("DFLG")) K PSONEW("NEWCOPAY"),PSONEWFF,PSOSCOTH,PSOSCOTX,PSOMESFI Q 37 ; 38 I PSOSCA&(PSOSCP>49)!((PSOSCA!(PSOBILL=2))&($P($G(^PS(53,+$G(PSONEW("PATIENT STATUS")),0)),"^",7)=1))!(PSOSCP>49&(PSOBILL=2)) D I $G(PSOCPZ("DFLG")) K PSOANSQ,PSONEW("NEWCOPAY"),PSONEWFF,PSOSCOTH,PSOSCOTX,PSOMESFI Q 39 . I PSOSCP<50 D MESS S:PSOSCP<50 PSOANSQD("SC>50")=$G(PSOANSQD("SC")) 40 . D SC^PSOMLLD2 41 . I PSOSCP<50&($D(PSOANSQD("SC"))) S PSOANSQD("SC")=PSOANSQD("SC>50") K PSOANSQD("SC") 42 ;IF MILL BILL, AND COPAY (*******TEST THE COPAY CHECK) 43 I $$DT^PSOMLLDT D I $G(PSOCPZ("DFLG")) K PSOANSQ,PSONEW("NEWCOPAY"),PSONEWFF,PSOSCOTH,PSOSCOTX,PSOMESFI Q 44 .;New prompts Quit after first '^' 45 .I $D(PSOIBQS(PSODFN,"CV")) D D MESSOI,MESS D CV^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("CV"))) K PSONEW("NEWCOPAY") 46 ..I '$D(PSOANSQD("CV")),($P(PSOPENIB,"^",6)=0!($P(PSOPENIB,"^",6)=1)) S PSOANSQD("CV")=$P(PSOPENIB,"^",6) 47 .I $D(PSOIBQS(PSODFN,"VEH")) D D MESSOI,MESS D VEH^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("VEH"))) K PSONEW("NEWCOPAY") 48 ..I '$D(PSOANSQD("VEH")),($P(PSOPENIB,"^",2)=0!($P(PSOPENIB,"^",2)=1)) S PSOANSQD("VEH")=$P(PSOPENIB,"^",2) 49 .I $D(PSOIBQS(PSODFN,"RAD")) D D MESSOI,MESS D RAD^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("RAD"))) K PSONEW("NEWCOPAY") 50 ..I '$D(PSOANSQD("RAD")),($P(PSOPENIB,"^",3)=0!($P(PSOPENIB,"^",3)=1)) S PSOANSQD("RAD")=$P(PSOPENIB,"^",3) 51 .I $D(PSOIBQS(PSODFN,"PGW")) D D MESSOI,MESS D PGW^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("PGW"))) K PSONEW("NEWCOPAY") 52 ..I '$D(PSOANSQD("PGW")),($P(PSOPENIB,"^",4)=0!($P(PSOPENIB,"^",4)=1)) S PSOANSQD("PGW")=$P(PSOPENIB,"^",4) 53 .I $D(PSOIBQS(PSODFN,"MST")) D D MESSOI,MESS D MST^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("MST"))) K PSONEW("NEWCOPAY") 54 ..I '$D(PSOANSQD("MST")),($P(PSOPENIB,"^")=0!($P(PSOPENIB,"^")=1)) S PSOANSQD("MST")=$P(PSOPENIB,"^") 55 .I $D(PSOIBQS(PSODFN,"HNC")) D D MESSOI,MESS D HNC^PSOMLLDT I $G(PSOCPZ("DFLG"))!($G(PSOANSQ("HNC"))) K PSONEW("NEWCOPAY") 56 ..I '$D(PSOANSQD("HNC")),($P(PSOPENIB,"^",5)=0!($P(PSOPENIB,"^",5)=1)) S PSOANSQD("HNC")=$P(PSOPENIB,"^",5) 57 K PSONEWFF,PSOSCOTH,PSOSCOTX,PSOMESFI,PSOSCA 58 Q 59 SET ;Set original answers that were passed from CPRS 60 Q:'$G(ORD) 61 Q:'$G(PSOFDR) 62 I $P($G(^PS(52.41,ORD,0)),"^",16)="SC"!($P($G(^(0)),"^",16)="NSC") D 63 . I PSOSCP<50 S PSOANSQ("SC")=$S($P($G(^(0)),"^",16)="SC":1,1:0),PSOANSQD("SC")=PSOANSQ("SC") S:PSOANSQ("SC")'="" PSOIBQS(PSODFN,"SC")=PSOANSQ("SC") 64 . I PSOSCP>49 S PSOANSQ("SC>50")=$S($P($G(^(0)),"^",16)="SC":1,1:0),PSOANSQD("SC>50")=PSOANSQ("SC>50") S:PSOANSQ("SC>50")'="" PSOIBQS(PSODFN,"SC>50")=PSOANSQ("SC>50") 65 I $G(PSOPENIB)="" G SET2 66 I '$$DT^PSOMLLDT Q 67 I $P(PSOPENIB,"^")=0!($P(PSOPENIB,"^")=1) S PSOANSQ("MST")=$P(PSOPENIB,"^") 68 I $P(PSOPENIB,"^",2)=0!($P(PSOPENIB,"^",2)=1) S PSOANSQ("VEH")=$P(PSOPENIB,"^",2) 69 I $P(PSOPENIB,"^",3)=0!($P(PSOPENIB,"^",3)=1) S PSOANSQ("RAD")=$P(PSOPENIB,"^",3) 70 I $P(PSOPENIB,"^",4)=0!($P(PSOPENIB,"^",4)=1) S PSOANSQ("PGW")=$P(PSOPENIB,"^",4) 71 I $P(PSOPENIB,"^",5)=0!($P(PSOPENIB,"^",5)=1) S PSOANSQ("HNC")=$P(PSOPENIB,"^",5) 72 I $P(PSOPENIB,"^",6)=0!($P(PSOPENIB,"^",6)=1) S PSOANSQ("CV")=$P(PSOPENIB,"^",6) 73 ; 74 SET2 ;for when patient status is exempt, null IBQ node was set for exempts or SC>50 - data is in ICD node 75 N PSOOICD 76 I $TR($G(^PS(52.41,+$G(ORD),"IBQ")),"^")="" S PSOOICD=$G(^PS(52.41,ORD,"ICD",1,0)) D SET3:PSOOICD'="" 77 ; 78 ICD1 ; 79 N PSONOCHG S PSONOCHG=0 80 I ('$D(PSORXED("ICD"))) S PSONOCHG=1 81 I $D(^PS(52.41,ORD,"ICD",0)) D 82 . N JJ,ICD,II,FLD,RXN S RXN=ORD 83 . S II=0 F S II=$O(^PS(52.41,ORD,"ICD",II)) Q:II=""!(II'?1N.N) D 84 .. S ICD=^PS(52.41,ORD,"ICD",II,0),FLD=$P(ICD,U) S:$G(PSONEW("IDFLG")) FLD="" D ICD 85 Q 86 ; 87 SET3 ; called from PSONEWF and PSONEWG; must have PSOOICD. For SC>50, exempt patient status, etc. 88 N JJJ 89 F JJJ=2:1:8 I $P(PSOOICD,"^",JJJ)=0!($P(PSOOICD,"^",JJJ)=1) D 90 . I JJJ=2 S (PSOANSQD("VEH"),PSOANSQ("VEH"))=$P(PSOOICD,"^",JJJ) 91 . I JJJ=3 S (PSOANSQD("RAD"),PSOANSQ("RAD"))=$P(PSOOICD,"^",JJJ) 92 . I JJJ=4 D 93 .. S:PSOSCP<50 (PSOANSQD("SC"),PSOANSQ("SC"))=$P(PSOOICD,"^",JJJ) 94 .. S:PSOSCP>49!($P($G(^PS(53,+$G(PSONEW("PATIENT STATUS")),0)),"^",7)=1) (PSOANSQD("SC>50"),PSOANSQ("SC>50"))=$P(PSOOICD,"^",JJJ) 95 . I JJJ=5 S (PSOANSQD("PGW"),PSOANSQ("PGW"))=$P(PSOOICD,"^",JJJ) 96 . I JJJ=6 S (PSOANSQD("MST"),PSOANSQ("MST"))=$P(PSOOICD,"^",JJJ) 97 . I JJJ=7 S (PSOANSQD("HNC"),PSOANSQ("HNC"))=$P(PSOOICD,"^",JJJ) 98 . I JJJ=8 S (PSOANSQD("CV"),PSOANSQ("CV"))=$P(PSOOICD,"^",JJJ) 99 K PSOOICD 100 Q 101 MESS ; 102 I $G(PSOSCOTX)=1&(PSOSCP<50) W:$G(PSODRUG("DEA"))'["S"&($G(PSODRUG("DEA"))'["I") !,"This Rx has been flagged by the provider as: "_$S($G(PSOSCOTH):"NO COPAY",$G(PSORX("SC"))="SC":"NO COPAY",1:"COPAY"),! S PSOSCOTX=2 103 Q 104 MESSOI ; 105 I $G(PSOMESFI)=1 W !!,"The Pharmacy Orderable Item has changed for this order. Please review any",!,"existing SC or Environmental Indicator defaults carefully for appropriateness.",! S PSOMESFI=2 106 Q 107 ; 108 ICD ;called from PSONEWG,PSORENW1 and used by PSONEWF 109 I $G(PSOCOPY)&($D(PSORXED("ICD")))&($D(PSONEW("IDFLG"))) Q:'$D(PSORXED("ICD",II)) 110 I $G(PSOCOPY)&($D(PSORXED("ICD",II))) S PSONEW("ICD",II)=PSORXED("ICD",II) Q 111 Q:'$G(PSOCOPY)&('$D(PSORXED("ICD",II)))&('$G(PSONOCHG)) ;don't set deleted ones 112 Q:$G(PSONEW("IDFLG")) 113 I $D(PSORX("ICD",II)) S PSONEW("ICD",II)=PSORX("ICD",II) Q 114 S PSONEW("ICD",II)=FLD 115 Q 116 ;
Note:
See TracChangeset
for help on using the changeset viewer.
