- 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/PSORN52.m
r613 r623 1 PSORN52 ;BIR/DSD - files renewal entries in prescription file ;08/09/93 2 ;;7.0;OUTPATIENT PHARMACY;**1,11,27,37,46,79,71,100,117,157,143,219,148,239,201,225**;DEC 1997;Build 29 3 ;Ext ref to ^PS(55 sup by DBIA 2228 4 ;Ext ref to PSOUL^PSSLOCK sup by DBIA 2789 5 ;Ext ref to ^VA(200 sup by DBIA 10060 6 ;Ext ref to SWSTAT^IBBAPI sup by DBIA 4663 7 EN(PSOX) ;EP 8 START ; 9 D:$D(XRTL) T0^%ZOSV ; Start RT Mon 10 N PSOIBHLD,PSOSCOTH,PSOSCOTX S (PSOSCOTH,PSOSCOTX)=0 S PSOIBHLD="" I $G(PSOFDR),$G(ORD) D 11 .S PSOIBHLD=$S($P($G(^PS(52.41,ORD,0)),"^",16)="SC":1,$P($G(^(0)),"^",16)="NSC":0,1:"") 12 .I '$$DT^PSOMLLDT Q 13 .N PSOIBHLX S PSOIBHLX=$G(^PS(52.41,ORD,"IBQ")) 14 .S PSOIBHLD=PSOIBHLD_"^"_$S($P(PSOIBHLX,"^")=1:1,$P(PSOIBHLX,"^")=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",2)=1:1,$P(PSOIBHLX,"^",2)=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",3)=1:1,$P(PSOIBHLX,"^",3)=0:0,1:"") 15 .S PSOIBHLD=PSOIBHLD_"^"_$S($P(PSOIBHLX,"^",4)=1:1,$P(PSOIBHLX,"^",4)=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",5)=1:1,$P(PSOIBHLX,"^",5)=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",6)=1:1,$P(PSOIBHLX,"^",6)=0:0,1:"") 16 .S PSOIBHLD=PSOIBHLD_"^"_$S($P(PSOIBHLX,"^",7)=1:1,$P(PSOIBHLX,"^",7)=0:0,1:"") 17 .I $P(PSOIBHLX,"^")=1!($P(PSOIBHLX,"^",2)=1)!($P(PSOIBHLX,"^",3)=1)!($P(PSOIBHLX,"^",4)=1)!($P(PSOIBHLX,"^",5)=1)!($P(PSOIBHLX,"^",6)=1)!($P(PSOIBHLX,"^",7)=1) S PSOSCOTH=1 18 I $G(PSOSCOTH)!($G(PSORX("SC"))="SC")!($G(PSORX("SC"))="NSC") S PSOSCOTX=1 19 S PSOANSQ("SC>50")="" D SCP^PSORN52D 20 I $G(PSOFDR),$G(ORD) I $D(^PS(52.41,ORD,"ICD")) S FILE=52.41 D GET^PSORN52D 21 ;Set ans to renew from Rx, only if no ans from Pend file 22 I $G(PSORENW("OIRXN")) D 23 .N PSOLDIBQ S PSOLDIBQ=$G(^PSRX(PSORENW("OIRXN"),"IBQ")) 24 .I $P(PSOIBHLD,"^")="" D 25 ..I $P($G(^PSRX(PSORENW("OIRXN"),"IB")),"^")=2 S $P(PSOIBHLD,"^")=0 26 .I '$$DT^PSOMLLDT Q 27 .I PSOLDIBQ="" Q 28 .D IBHLD^PSORN52A 29 D INIT G:PSORN52("QFLG") END D FILE^PSORN52A 30 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; Stop RT Mon 31 K PSOANSQ,PSOANSQD,PSONEWFF 32 I $G(PSOIBHLD)'="" D 33 .;Set answers based on Pend Renew, prior to Phar call 34 .Q:'$G(PSOX("IRXN")) 35 .I $P(PSOIBHLD,"^")=1!($P(PSOIBHLD,"^")=0) S PSOANSQ("SC")=$P(PSOIBHLD,"^") 36 .I '$$DT^PSOMLLDT Q 37 .I $P(PSOIBHLD,"^",2)=1!($P(PSOIBHLD,"^",2)=0) S PSOANSQ(PSOX("IRXN"),"MST")=$P(PSOIBHLD,"^",2) 38 .I $P(PSOIBHLD,"^",3)=1!($P(PSOIBHLD,"^",3)=0) S PSOANSQ(PSOX("IRXN"),"VEH")=$P(PSOIBHLD,"^",3) 39 .I $P(PSOIBHLD,"^",4)=1!($P(PSOIBHLD,"^",4)=0) S PSOANSQ(PSOX("IRXN"),"RAD")=$P(PSOIBHLD,"^",4) 40 .I $P(PSOIBHLD,"^",5)=1!($P(PSOIBHLD,"^",5)=0) S PSOANSQ(PSOX("IRXN"),"PGW")=$P(PSOIBHLD,"^",5) 41 .I $P(PSOIBHLD,"^",6)=1!($P(PSOIBHLD,"^",6)=0) S PSOANSQ(PSOX("IRXN"),"HNC")=$P(PSOIBHLD,"^",6) 42 .I $P(PSOIBHLD,"^",7)=1!($P(PSOIBHLD,"^",7)=0) S PSOANSQ(PSOX("IRXN"),"CV")=$P(PSOIBHLD,"^",7) 43 .I $P(PSOIBHLD,"^",8)=1!($P(PSOIBHLD,"^",8)=0) S PSOANSQ(PSOX("IRXN"),"SHAD")=$P(PSOIBHLD,"^",8) 44 K PSOIBHLD 45 I '$G(PSOFDR) I $G(PSORENW("OIRXN")) S FILE=52 D GET^PSORN52D 46 S PSONEW("NEWCOPAY")="" 47 I (PSOSCP<50&('$P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7))),$G(DUZ("AG"))="V" S PSOFLAG=0 D COPAY^PSOCPB 48 ;I PSOSCP>49!($P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7)=1) S PSOFLAG=0 D SC^PSOMLLD2 49 I PSOSCA&(PSOSCP>49)!((PSOSCA!(PSOBILL=2))&($P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7)=1)) S PSOFLAG=0 D SC^PSOMLLD2 50 I $$DT^PSOMLLDT D 51 .I $D(PSOIBQS(PSODFN,"CV")) D MESS D CV^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"CV")) K PSONEW("NEWCOPAY") 52 .I $D(PSOIBQS(PSODFN,"VEH")) D MESS D VEH^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"VEH")) K PSONEW("NEWCOPAY") 53 .I $D(PSOIBQS(PSODFN,"RAD")) D MESS D RAD^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"RAD")) K PSONEW("NEWCOPAY") 54 .I $D(PSOIBQS(PSODFN,"PGW")) D MESS D PGW^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"PGW")) K PSONEW("NEWCOPAY") 55 .I $D(PSOIBQS(PSODFN,"SHAD")) D MESS D SHAD^PSOMLLD2 I $G(PSOANSQ(PSOX("IRXN"),"SHAD")) K PSONEW("NEWCOPAY") 56 .I $D(PSOIBQS(PSODFN,"MST")) D MESS D MST^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"MST")) K PSONEW("NEWCOPAY") 57 .I $D(PSOIBQS(PSODFN,"HNC")) D MESS D HNC^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"HNC")) K PSONEW("NEWCOPAY") 58 K PSOSCOTH,PSOSCOTX 59 I $G(PSONEW("NEWCOPAY")) S ^PSRX(PSOX("IRXN"),"IB")=PSONEW("NEWCOPAY") 60 ; 61 D FINISH,ACP^PSOUTIL 62 ; 63 N PSOSCFLD S PSOSCFLD=$S(PSOSCP'="":$G(PSOANSQ("SC")),1:"")_"^"_$G(PSOANSQ(PSOX("IRXN"),"MST"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"VEH"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"RAD")) 64 S PSOSCFLD=PSOSCFLD_"^"_$G(PSOANSQ(PSOX("IRXN"),"PGW"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"HNC"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"CV"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"SHAD")) 65 I PSOSCP<50&($TR(PSOSCFLD,"^")'="")&('$P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7)) S ^PSRX(PSOX("IRXN"),"IBQ")=PSOSCFLD K PSOSCFLD 66 ; 67 D FILE2^PSORN52D 68 D:$$SWSTAT^IBBAPI() GACT^PSOPFSU0(PSOX("IRXN"),0) 69 K PSONEW("NEWCOPAY"),PSOANSQ 70 END D EOJ 71 Q 72 INIT S PSORN52("QFLG")=0 S:'$D(PSOX("DAYS SUPPLY")) PSOX("DAYS SUPPLY")=$P(PSOX("RX0"),"^",8) 73 S:'$D(PSOX("# OF REFILLS")) PSOX("# OF REFILLS")=$P(PSOX("RX0"),"^",9) S:'$D(PSOX("ISSUE DATE")) PSOX("ISSUE DATE")=DT 74 D INIT^PSON52 K PSON52 75 Q 76 ; 77 FINISH ; 78 G:PSOX("STATUS")=4 FINISHP 79 I $D(PSORX("VERIFY")) D G FINISHX 80 .K DIC,DLAYGO,DINUM,DIADD,X,DD,DO S DIC="^PS(52.4,",DLAYGO=52.4,DINUM=PSOX("IRXN"),DIC(0)="ML" 81 .S X=PSOX("IRXN") D FILE^DICN K DD,DO,DIC,DLAYGO,DINUM,X 82 .S ^PS(52.4,PSOX("IRXN"),0)=PSOX("IRXN")_"^"_$P(PSOX("NRX0"),"^",2)_"^"_DUZ_"^"_$G(PSOX("OIRXN"))_"^"_$E(PSOX("LOGIN DATE"),1,7)_"^"_PSOX("IRXN")_"^"_PSOX("STOP DATE") 83 .K DIK,DA S DIK="^PS(52.4,",DA=PSOX("IRXN") D IX^DIK K DIK,DA 84 ; 85 I $G(PSOX("QS"))="S",$G(PSOBARCD) S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=0 D SUS^PSORXL K DA G FINISHX 86 ; 87 I PSOX("FILL DATE")>DT,$P(PSOPAR,"^",6) S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=0 D SUS^PSORXL K DA G FINISHX 88 ; 89 ; - Submitting Rx to ECME for 3rd Party Billing 90 N ACTION 91 I $$SUBMIT^PSOBPSUT(PSOX("IRXN"),0) D I ACTION="Q"!(ACTION="^") Q 92 . S ACTION="" D ECMESND^PSOBPSU1(PSOX("IRXN"),0,PSOX("FILL DATE"),"RN") 93 . I $$FIND^PSOREJUT(PSOX("IRXN"),0) D 94 . . S ACTION=$$HDLG^PSOREJU1(PSOX("IRXN"),0,"79,88","RN","IOQ","I") 95 ; 96 I $G(PSOX("QS"))="Q",$G(PSOBARCD) D G FINISHX 97 . N PSOFROM S PSOFROM="BATCH" I $G(PPL),$L(PPL_PSOX("IRXN")_",")>240 D TRI^PSOBBC D Q^PSORXL K PPL,RXFL 98 .S RXFL(PSOX("IRXN"))=0 99 . I $G(PPL) S PPL=PPL_PSOX("IRXN")_"," 100 . E S PPL=PSOX("IRXN")_"," 101 . Q 102 FINISHP I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSOX("IRXN")_",",RXFL(PSOX("IRXN"))=0 G FINISHX 103 F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 104 I $L(PSORX("PSOL",PSOX2))+$L(PSOX("IRXN"))<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_"," 105 E S PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_"," 106 S RXFL(PSOX("IRXN"))=0 107 FINISHX ; 108 ;call to build bingo board Rx array 109 S:'$G(PSORX("MAIL/WINDOW")) PSORX("MAIL/WINDOW")=$P(PSORENW("NRX0"),"^",11) 110 I $G(PSORX("MAIL/WINDOW"))["W" S BINGCRT=1,BINGRTE="W",BBFLG=1 D BBRX^PSORN52C 111 K PSOX1,PSOX2 112 Q 113 EOJ ; 114 L -^PSRX("B",PSOX("IRXN")) K PSORN52,PSOX("INS"),PSORENW("INS"),PSORXED("INS"),PSONEW("ENT"),PSORXED("ENT"),OLENT,PSOIBHLD,PSOX("SINS"),PSORENW("SINS"),PSORXED("SINS"),FILE 115 D PSOUL^PSSLOCK(PSOX("IRXN")) D PSOUL^PSSLOCK(PSOX("OIRXN")) 116 Q 117 MESS ; 118 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 119 Q 1 PSORN52 ;BIR/DSD - files renewal entries in prescription file ; 3/11/07 4:42pm 2 ;;7.0;OUTPATIENT PHARMACY;**1,11,27,37,46,79,71,100,117,157,143,219,148,239,201,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 ;Ext ref to ^PS(55 sup by DBIA 2228 20 ;Ext ref to PSOUL^PSSLOCK sup by DBIA 2789 21 ;Ext ref to ^VA(200 sup by DBIA 10060 22 ;Ext ref to SWSTAT^IBBAPI sup by DBIA 4663 23 EN(PSOX) ;EP 24 START ; 25 D:$D(XRTL) T0^%ZOSV ; Start RT Mon 26 N PSOIBHLD,PSOSCOTH,PSOSCOTX S (PSOSCOTH,PSOSCOTX)=0 S PSOIBHLD="" I $G(PSOFDR),$G(ORD) D 27 .S PSOIBHLD=$S($P($G(^PS(52.41,ORD,0)),"^",16)="SC":1,$P($G(^(0)),"^",16)="NSC":0,1:"") 28 .I '$$DT^PSOMLLDT Q 29 .N PSOIBHLX S PSOIBHLX=$G(^PS(52.41,ORD,"IBQ")) 30 .S PSOIBHLD=PSOIBHLD_"^"_$S($P(PSOIBHLX,"^")=1:1,$P(PSOIBHLX,"^")=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",2)=1:1,$P(PSOIBHLX,"^",2)=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",3)=1:1,$P(PSOIBHLX,"^",3)=0:0,1:"") 31 .S PSOIBHLD=PSOIBHLD_"^"_$S($P(PSOIBHLX,"^",4)=1:1,$P(PSOIBHLX,"^",4)=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",5)=1:1,$P(PSOIBHLX,"^",5)=0:0,1:"")_"^"_$S($P(PSOIBHLX,"^",6)=1:1,$P(PSOIBHLX,"^",6)=0:0,1:"") 32 .I $P(PSOIBHLX,"^")=1!($P(PSOIBHLX,"^",2)=1)!($P(PSOIBHLX,"^",3)=1)!($P(PSOIBHLX,"^",4)=1)!($P(PSOIBHLX,"^",5)=1)!($P(PSOIBHLX,"^",6)=1) S PSOSCOTH=1 33 I $G(PSOSCOTH)!($G(PSORX("SC"))="SC")!($G(PSORX("SC"))="NSC") S PSOSCOTX=1 34 S PSOANSQ("SC>50")="" D SCP^PSORN52D 35 I $G(PSOFDR),$G(ORD) I $D(^PS(52.41,ORD,"ICD")) S FILE=52.41 D GET^PSORN52D 36 ;Set ans to renew from Rx, only if no ans from Pend file 37 I $G(PSORENW("OIRXN")) D 38 .N PSOLDIBQ S PSOLDIBQ=$G(^PSRX(PSORENW("OIRXN"),"IBQ")) 39 .I $P(PSOIBHLD,"^")="" D 40 ..I $P($G(^PSRX(PSORENW("OIRXN"),"IB")),"^")=2 S $P(PSOIBHLD,"^")=0 41 .I '$$DT^PSOMLLDT Q 42 .I PSOLDIBQ="" Q 43 .D IBHLD^PSORN52A 44 D INIT G:PSORN52("QFLG") END D FILE^PSORN52A 45 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; Stop RT Mon 46 K PSOANSQ,PSOANSQD,PSONEWFF 47 I $G(PSOIBHLD)'="" D 48 .;Set answers based on Pend Renew, prior to Phar call 49 .Q:'$G(PSOX("IRXN")) 50 .I $P(PSOIBHLD,"^")=1!($P(PSOIBHLD,"^")=0) S PSOANSQ("SC")=$P(PSOIBHLD,"^") 51 .I '$$DT^PSOMLLDT Q 52 .I $P(PSOIBHLD,"^",2)=1!($P(PSOIBHLD,"^",2)=0) S PSOANSQ(PSOX("IRXN"),"MST")=$P(PSOIBHLD,"^",2) 53 .I $P(PSOIBHLD,"^",3)=1!($P(PSOIBHLD,"^",3)=0) S PSOANSQ(PSOX("IRXN"),"VEH")=$P(PSOIBHLD,"^",3) 54 .I $P(PSOIBHLD,"^",4)=1!($P(PSOIBHLD,"^",4)=0) S PSOANSQ(PSOX("IRXN"),"RAD")=$P(PSOIBHLD,"^",4) 55 .I $P(PSOIBHLD,"^",5)=1!($P(PSOIBHLD,"^",5)=0) S PSOANSQ(PSOX("IRXN"),"PGW")=$P(PSOIBHLD,"^",5) 56 .I $P(PSOIBHLD,"^",6)=1!($P(PSOIBHLD,"^",6)=0) S PSOANSQ(PSOX("IRXN"),"HNC")=$P(PSOIBHLD,"^",6) 57 .I $P(PSOIBHLD,"^",7)=1!($P(PSOIBHLD,"^",7)=0) S PSOANSQ(PSOX("IRXN"),"CV")=$P(PSOIBHLD,"^",7) 58 K PSOIBHLD 59 I '$G(PSOFDR) I $G(PSORENW("OIRXN")) S FILE=52 D GET^PSORN52D 60 S PSONEW("NEWCOPAY")="" 61 I (PSOSCP<50&('$P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7))),$G(DUZ("AG"))="V" S PSOFLAG=0 D COPAY^PSOCPB 62 ;I PSOSCP>49!($P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7)=1) S PSOFLAG=0 D SC^PSOMLLD2 63 I PSOAFYN="Y" G AFIN ;vfah 64 I PSOSCA&(PSOSCP>49)!((PSOSCA!(PSOBILL=2))&($P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7)=1)) S PSOFLAG=0 D SC^PSOMLLD2 65 I $$DT^PSOMLLDT D 66 .I $D(PSOIBQS(PSODFN,"CV")) D MESS D CV^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"CV")) K PSONEW("NEWCOPAY") 67 .I $D(PSOIBQS(PSODFN,"VEH")) D MESS D VEH^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"VEH")) K PSONEW("NEWCOPAY") 68 .I $D(PSOIBQS(PSODFN,"RAD")) D MESS D RAD^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"RAD")) K PSONEW("NEWCOPAY") 69 .I $D(PSOIBQS(PSODFN,"PGW")) D MESS D PGW^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"PGW")) K PSONEW("NEWCOPAY") 70 .I $D(PSOIBQS(PSODFN,"MST")) D MESS D MST^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"MST")) K PSONEW("NEWCOPAY") 71 .I $D(PSOIBQS(PSODFN,"HNC")) D MESS D HNC^PSOMLLDT I $G(PSOANSQ(PSOX("IRXN"),"HNC")) K PSONEW("NEWCOPAY") 72 K PSOSCOTH,PSOSCOTX 73 I $G(PSONEW("NEWCOPAY")) S ^PSRX(PSOX("IRXN"),"IB")=PSONEW("NEWCOPAY") 74 ; 75 AFIN D FINISH,ACP^PSOUTIL ;vfah copay not evaluated by Autofinish,Rx 76 ; 77 N PSOSCFLD S PSOSCFLD=$S(PSOSCP'="":$G(PSOANSQ("SC")),1:"")_"^"_$G(PSOANSQ(PSOX("IRXN"),"MST"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"VEH"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"RAD")) 78 S PSOSCFLD=PSOSCFLD_"^"_$G(PSOANSQ(PSOX("IRXN"),"PGW"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"HNC"))_"^"_$G(PSOANSQ(PSOX("IRXN"),"CV")) 79 I PSOSCP<50&($TR(PSOSCFLD,"^")'="")&('$P($G(^PS(53,+$P(^PSRX(PSOX("IRXN"),0),"^",3),0)),"^",7)) S ^PSRX(PSOX("IRXN"),"IBQ")=PSOSCFLD K PSOSCFLD 80 ; 81 D FILE2^PSORN52D 82 D:$$SWSTAT^IBBAPI() GACT^PSOPFSU0(PSOX("IRXN"),0) 83 K PSONEW("NEWCOPAY"),PSOANSQ 84 END D EOJ 85 Q 86 INIT S PSORN52("QFLG")=0 S:'$D(PSOX("DAYS SUPPLY")) PSOX("DAYS SUPPLY")=$P(PSOX("RX0"),"^",8) 87 S:'$D(PSOX("# OF REFILLS")) PSOX("# OF REFILLS")=$P(PSOX("RX0"),"^",9) S:'$D(PSOX("ISSUE DATE")) PSOX("ISSUE DATE")=DT 88 D INIT^PSON52 K PSON52 89 Q 90 ; 91 FINISH ; 92 G:PSOX("STATUS")=4 FINISHP 93 I $D(PSORX("VERIFY")) D G FINISHX 94 .K DIC,DLAYGO,DINUM,DIADD,X,DD,DO S DIC="^PS(52.4,",DLAYGO=52.4,DINUM=PSOX("IRXN"),DIC(0)="ML" 95 .S X=PSOX("IRXN") D FILE^DICN K DD,DO,DIC,DLAYGO,DINUM,X 96 .S ^PS(52.4,PSOX("IRXN"),0)=PSOX("IRXN")_"^"_$P(PSOX("NRX0"),"^",2)_"^"_DUZ_"^"_$G(PSOX("OIRXN"))_"^"_$E(PSOX("LOGIN DATE"),1,7)_"^"_PSOX("IRXN")_"^"_PSOX("STOP DATE") 97 .K DIK,DA S DIK="^PS(52.4,",DA=PSOX("IRXN") D IX^DIK K DIK,DA 98 ; 99 I $G(PSOX("QS"))="S",$G(PSOBARCD) S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=0 D SUS^PSORXL K DA G FINISHX 100 ; 101 I PSOX("FILL DATE")>DT,$P(PSOPAR,"^",6) S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=0 D SUS^PSORXL K DA G FINISHX 102 ; 103 ; - Submitting Rx to ECME for 3rd Party Billing 104 N ACTION 105 I $$SUBMIT^PSOBPSUT(PSOX("IRXN"),0) D I ACTION="Q"!(ACTION="^") Q 106 . S ACTION="" D ECMESND^PSOBPSU1(PSOX("IRXN"),0,PSOX("FILL DATE"),"RN") 107 . I $$FIND^PSOREJUT(PSOX("IRXN"),0) D 108 . . S ACTION=$$HDLG^PSOREJU1(PSOX("IRXN"),0,"79,88","RN","IOQ","I") 109 ; 110 I $G(PSOX("QS"))="Q",$G(PSOBARCD) D G FINISHX 111 . N PSOFROM S PSOFROM="BATCH" I $G(PPL),$L(PPL_PSOX("IRXN")_",")>240 D TRI^PSOBBC D Q^PSORXL K PPL,RXFL 112 .S RXFL(PSOX("IRXN"))=0 113 . I $G(PPL) S PPL=PPL_PSOX("IRXN")_"," 114 . E S PPL=PSOX("IRXN")_"," 115 . Q 116 FINISHP I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSOX("IRXN")_",",RXFL(PSOX("IRXN"))=0 G FINISHX 117 F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 118 I $L(PSORX("PSOL",PSOX2))+$L(PSOX("IRXN"))<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_"," 119 E S PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_"," 120 S RXFL(PSOX("IRXN"))=0 121 FINISHX ; 122 ;call to build bingo board Rx array 123 S:'$G(PSORX("MAIL/WINDOW")) PSORX("MAIL/WINDOW")=$P(PSORENW("NRX0"),"^",11) 124 I $G(PSORX("MAIL/WINDOW"))["W" S BINGCRT=1,BINGRTE="W",BBFLG=1 D BBRX^PSORN52C 125 K PSOX1,PSOX2 126 Q 127 EOJ ; 128 L -^PSRX("B",PSOX("IRXN")) K PSORN52,PSOX("INS"),PSORENW("INS"),PSORXED("INS"),PSONEW("ENT"),PSORXED("ENT"),OLENT,PSOIBHLD,PSOX("SINS"),PSORENW("SINS"),PSORXED("SINS"),FILE 129 D PSOUL^PSSLOCK(PSOX("IRXN")) D PSOUL^PSSLOCK(PSOX("OIRXN")) 130 Q 131 MESS ; 132 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 133 Q
Note:
See TracChangeset
for help on using the changeset viewer.
