- 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/PSON52.m
r613 r623 1 PSON52 ;BIR/DSD - files new entries in prescription file ;08/09/93 2 ;;7.0;OUTPATIENT PHARMACY;**1,16,23,27,32,46,71,111,124,117,131,139,157,143,219,148,239,201,268,260,225**;DEC 1997;Build 29 3 ;External reference ^PS(55 supported by DBIA 2228 4 ;External reference to PSOUL^PSSLOCK supported by DBIA 2789 5 ;External reference to ^XUSEC supported by DBIA 10076 6 ;External reference SWSTAT^IBBAPI supported by DBIA 4663 7 ;External reference SAVNDC^PSSNDCUT supported by DBIA 4707 8 EN(PSOX) ;Entry Point 9 START ; 10 D:$D(XRTL) T0^%ZOSV ; Start RT Monitor 11 D INIT G:PSON52("QFLG") END D NFILE Q:$G(PSONEW("DFLG")) D PS55,DIK 12 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; Stop RT Monitor 13 D FINISH 14 I $P(^PSRX(PSOX("IRXN"),0),"^",11)="W",$G(^("IB")) S ^PSRX("ACP",$P(^PSRX(PSOX("IRXN"),0),"^",2),$P(^(2),"^",2),0,PSOX("IRXN"))="" 15 END D EOJ 16 Q 17 INIT ; 18 K X,%DT S:$G(PSOID) PSOX("ISSUE DATE")=PSOID 19 S PSOX("CS")=0 20 F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S $P(PSOX("CS"),"^")=1 S:$E(+PSODRUG("DEA"),DEA)=2 $P(PSOX("CS"),"^",2)=1 21 S PSON52("QFLG")=0,X1=PSOX("ISSUE DATE"),X2=PSOX("DAYS SUPPLY")*(PSOX("# OF REFILLS")+1)\1 22 I $D(CLOZPAT) S X2=$S(X2=14:14,X2=7:7,1:X2) G DT 23 S X2=$S(PSOX("DAYS SUPPLY")=X2:X2,+$G(PSOX("CS")):184,+$G(DEA("CS")):184,1:366) 24 I X2<30 D 25 . N % S %=$P($G(PSORX("PATIENT STATUS")),"^"),X2=30 26 . S:%?.N %=$P($G(^PS(53,+%,0)),"^") I %["AUTH ABS" S X2=5 27 DT D C^%DTC S PSOX("STOP DATE")=$P(X,".") K X 28 I PSOX("# OF REFILLS")>0 S X1=PSOX("FILL DATE"),X2=$S((PSOX("DAYS SUPPLY")-10\1)<1:1,1:PSOX("DAYS SUPPLY")-10\1) D C^%DTC S PSOX("NEXT POSSIBLE REFILL")=$P(X,".") K X 29 S PSOX("TYPE OF RX")=0,PSOX("DISPENSED DATE")=PSOX("FILL DATE") D NOW^%DTC S PSOX("LOGIN DATE")=$S($P($G(OR0),"^",12):$P($G(OR0),"^",12),1:%) K %,X 30 S PSOX("STATUS")=$S($G(PSOX("STATUS"))]"":PSOX("STATUS"),$D(PSORX("VERIFY")):1,1:0) 31 S PSOX("COPIES")=$S($G(PSOX("COPIES"))]"":PSOX("COPIES"),1:1) 32 I $G(PSORX("PHARM"))]"" S PSOX("PHARMACIST")=PSORX("PHARM") K PSORX("PHARM") 33 INITX Q 34 ; 35 NFILE I $G(OR0) D Q:$G(PSONEW("DFLG")) 36 .D NOOR^PSONEW Q:$G(PSONEW("DFLG")) 37 .I $G(PSOSIGFL)!($G(PSODRUG("OI"))'=$P(OR0,"^",8)) S PSONEW("CLERK CODE")=DUZ,PSONEW("REMARKS")=$G(PSONEW("REMARKS"))_" CPRS Order #"_$P(OR0,"^")_" Edited." 38 S DIC="^PSRX(",DLAYGO=52,DIC(0)="L",X=PSOX("RX #") K DD,DO D FILE^DICN S PSOX("IRXN")=+Y K DLAYGO,X,Y,DIC,DD,DO D:+$G(DGI) TECH^PSODGDGI 39 F PSOX1=0:1 S PSON52=$P($T(DD+PSOX1),";;",2,4) Q:PSON52="" K PSOY S PSOY=$P(PSON52,";;") I $G(@PSOY)]"" S $P(PSON52(PSOX("IRXN"),$P(PSON52,";;",2)),"^",$P(PSON52,";;",3))=@PSOY 40 F I=1:1:PSOX("ENT") S ^PSRX(PSOX("IRXN"),6,I,0)=PSOX("DOSE",I)_"^"_$G(PSOX("DOSE ORDERED",I))_"^"_$G(PSOX("UNITS",I))_"^"_$G(PSOX("NOUN",I))_"^" D 41 .S ^PSRX(PSOX("IRXN"),6,I,0)=^PSRX(PSOX("IRXN"),6,I,0)_$G(PSOX("DURATION",I))_"^"_$G(PSOX("CONJUNCTION",I))_"^"_$G(PSOX("ROUTE",I))_"^"_$G(PSOX("SCHEDULE",I))_"^"_$G(PSOX("VERB",I)) 42 .I $G(PSOX("ODOSE",I))]"" S ^PSRX(PSOX("IRXN"),6,I,1)=PSOX("ODOSE",I) 43 S ^PSRX(PSOX("IRXN"),6,0)="^52.0113^"_PSOX("ENT")_"^"_PSOX("ENT") 44 K PSOX1,PSOY 45 S PSOX1="" F S PSOX1=$O(PSON52(PSOX("IRXN"),PSOX1)) Q:PSOX1="" S ^PSRX(PSOX("IRXN"),PSOX1)=$G(PSON52(PSOX("IRXN"),PSOX1)) 46 I $O(PSOX("SIG",0)) D 47 .S D=0 F S D=$O(PSOX("SIG",D)) Q:'D S ^PSRX(PSOX("IRXN"),"INS1",D,0)=PSOX("SIG",D),TP=$G(TP)+1 48 .S ^PSRX(PSOX("IRXN"),"INS1",0)="^52.0115^"_TP_"^"_TP_"^"_DT_"^^" K TP,D 49 I $G(PSOX("SINS"))]"" S ^PSRX(PSOX("IRXN"),"INSS")=PSOX("SINS") 50 I $G(SIGOK) D 51 .S $P(^PSRX(PSOX("IRXN"),"SIG"),"^",2)=1,^PSRX(PSOX("IRXN"),"SIG1",0)="^52.04A^^" 52 .S D=0 F S D=$O(SIG(D)) Q:'D S ^PSRX(PSOX("IRXN"),"SIG1",D,0)=SIG(D),$P(^PSRX(PSOX("IRXN"),"SIG1",0),"^",3)=+$P(^PSRX(PSOX("IRXN"),"SIG1",0),"^",3)+1,$P(^(0),"^",4)=+$P(^(0),"^",4)+1 Q:'$O(SIG(D)) 53 .K SIG 54 I $D(PSOINSFL) S ^PSRX(PSOX("IRXN"),"A",0)="^52.3DA^1^1",^PSRX(PSOX("IRXN"),"A",1,0)=DT_"^G^^0^Patient Instructions "_$S(PSOINSFL=1:"",1:"Not ")_"Sent By Provider." 55 I $G(OR0) S:$P(OR0,"^",24) ^PSRX(PSOX("IRXN"),"PKI")=1 56 K PSOX1,PSOFINFL,HLDSIG,D,PSOINSFL,D 57 D:$G(^TMP("PSODAI",$J,0)) 58 .S $P(^PSRX(PSOX("IRXN"),3),"^",6)=1 59 .I $O(^TMP("PSODAI",$J,0)) S DAI=0 F S DAI=$O(^TMP("PSODAI",$J,DAI)) Q:'DAI D 60 ..S:'$D(^PSRX(PSOX("IRXN"),"DAI",0)) ^PSRX(PSOX("IRXN"),"DAI",0)="^52.03^^" S ^PSRX(PSOX("IRXN"),"DAI",DAI,0)=^TMP("PSODAI",$J,DAI,0) 61 ..S $P(^PSRX(PSOX("IRXN"),"DAI",0),"^",3)=+$P(^PSRX(PSOX("IRXN"),"DAI",0),"^",3)+1,$P(^(0),"^",4)=+$P(^(0),"^",4)+1 62 .K ^TMP("PSODAI",$J),DAI 63 I $G(PSOX("CHCS NUMBER"))'="" S $P(^PSRX(PSOX("IRXN"),"EXT"),"^")=$G(PSOX("CHCS NUMBER")) 64 I $G(PSOX("EXTERNAL SYSTEM"))'="" S $P(^PSRX(PSOX("IRXN"),"EXT"),"^",2)=$G(PSOX("EXTERNAL SYSTEM")) 65 I $G(PSOX("NEWCOPAY")) S ^PSRX(PSOX("IRXN"),"IB")=$G(PSOX("NEWCOPAY")) 66 ;Next line, set SC question based on Copay status? 67 IBQ ;I $G(PSOBILL)=2 S ^PSRX(PSOX("IRXN"),"IBQ")=$S($G(PSOX("NEWCOPAY")):0,1:1) 68 N PSOSCFLD S PSOSCFLD=$S(PSOSCP'="":$G(PSOANSQ("SC")),1:"")_"^"_$G(PSOANSQ("MST"))_"^"_$G(PSOANSQ("VEH"))_"^"_$G(PSOANSQ("RAD"))_"^"_$G(PSOANSQ("PGW"))_"^"_$G(PSOANSQ("HNC"))_"^"_$G(PSOANSQ("CV"))_"^"_$G(PSOANSQ("SHAD")) 69 I PSOSCP<50&($TR(PSOSCFLD,"^")'="")&($P($G(^PS(53,+$G(PSONEW("PATIENT STATUS")),0)),"^",7)'=1) D 70 . S ^PSRX(PSOX("IRXN"),"IBQ")=PSOSCFLD K PSOSCFLD ;don't set if SC % is null or 0, just set it in ICD node 71 D ICD^PSODIAG 72 D:$$SWSTAT^IBBAPI() GACT^PSOPFSU0(PSOX("IRXN"),0) 73 K PSOANSQ,PSOANSQD,PSOX("NEWCOPAY") 74 L -^PSRX("B",PSOX("IRXN")) 75 Q 76 ; 77 PS55 ; 78 L +^PS(55,PSODFN,"P"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) 79 S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^" 80 F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1)) 81 S PSOX("55 IEN")=PSOX1 82 S ^PS(55,PSODFN,"P",PSOX1,0)=PSOX("IRXN"),$P(^PS(55,PSODFN,"P",0),"^",3,4)=PSOX1_"^"_($P(^PS(55,PSODFN,"P",0),"^",4)+1) 83 S ^PS(55,PSODFN,"P","A",PSONEW("STOP DATE"),PSOX("IRXN"))="" 84 PS55X L -^PS(55,PSODFN,"P") 85 K PSOX1 86 Q 87 DIK ; 88 I $D(^XUSEC("PSORPH",DUZ)) S DA=PSOX("IRXN"),DIE=52,DR="41////"_PSOCOU_";S:'X Y=""@1"";42////"_PSOCOUU_";@1" D ^DIE K DIE,DR 89 K DIK,DA S DIK="^PSRX(",DA=PSOX("IRXN") D IX1^DIK K DIK 90 S DA=PSOX("IRXN") D ORC^PSORN52C 91 Q 92 FINISH ; 93 ANQ I $G(ANQDATA)]"" D NOW^%DTC G:$D(^PS(52.52,"B",%)) ANQ D 94 .K DD,DO S DIC="^PS(52.52,",DIC(0)="L",DLAYGO=52.52,X=% D FILE^DICN K DIC,DLAYGO,DD,DO 95 .S ^PS(52.52,+Y,0)=$P(Y,"^",2)_"^"_PSOX("IRXN")_"^"_ANQDATA,^PS(52.52,"A",PSOX("IRXN"),+Y)="" K ANQDATA,X,Y,%,ANQREM 96 G:PSOX("STATUS")=4 FINISHP 97 I $D(PSORX("VERIFY")) D G FINISHX 98 .K DIC,DLAYGO,DINUM,DIADD,X,DD,DO S DIC="^PS(52.4,",DLAYGO=52.4,DINUM=PSOX("IRXN"),DIC(0)="ML",X=PSOX("IRXN") 99 .D FILE^DICN K DD,DO,DIC,DLAYGO,DINUM S ^PS(52.4,PSOX("IRXN"),0)=PSOX("IRXN")_"^"_PSODFN_"^"_DUZ_"^"_"^"_$E(PSOX("LOGIN DATE"),1,7)_"^"_PSOX("IRXN")_"^"_PSOX("STOP DATE") 100 .K DIK,DA S DIK="^PS(52.4,",DA=PSOX("IRXN") D IX^DIK K DIK,DA 101 ; 102 I PSOX("FILL DATE")>DT,$P(PSOPAR,"^",6) S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=0 D SUS^PSORXL K DA G FINISHX 103 ; 104 ; - Calling ECME for claims generation and transmission / REJECT handling 105 N ACTION,PSOERX 106 S PSOERX=PSOX("IRXN") 107 I $$SUBMIT^PSOBPSUT(PSOERX,0) D I ACTION="Q"!(ACTION="^") Q 108 . S ACTION="" D ECMESND^PSOBPSU1(PSOERX,0,PSOX("FILL DATE"),"OF") 109 . I $$FIND^PSOREJUT(PSOERX,0) D 110 . . S ACTION=$$HDLG^PSOREJU1(PSOERX,0,"79,88","OF","IOQ","I") 111 . I $$STATUS^PSOBPSUT(PSOERX,0)="E PAYABLE" D 112 . . D SAVNDC^PSSNDCUT(+$$GET1^DIQ(52,PSOERX,6,"I"),$G(PSOSITE),$$GETNDC^PSONDCUT(PSOERX,0)) 113 ; 114 FINISHP ; 115 I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSOX("IRXN")_",",RXFL(PSOX("IRXN"))=0 G FINISHX 116 F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 117 I $L(PSORX("PSOL",PSOX2))+$L(PSOX("IRXN"))<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_"," 118 E S PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_"," 119 S RXFL(PSOX("IRXN"))=0 120 FINISHX ;call to build Rx array for bingo board 121 I $G(PSORX("MAIL/WINDOW"))["W" S BINGCRT=1,BINGRTE="W",BBFLG=1 D BBRX^PSORN52C 122 K PSOX1,PSOX2 123 Q 124 EOJ ; 125 ;B xref locked in routine PSONRXN 126 L -^PSRX("B",PSOX("IRXN")) K OTHDOS,DA,PSON52,PSOPRC,RTE,SCH,PSOX("INS"),PSONEW("INS"),PSORXED("INS"),PSONEW("ENT"),PSORXED("ENT"),OLENT 127 D PSOUL^PSSLOCK(PSOX("IRXN")) 128 Q 129 ; 130 ;;PSOX("SIG");;SIG;;1 131 DD ;;PSOX("RX #");;0;;1 132 ;;PSOX("ISSUE DATE");;0;;13 133 ;;PSODFN;;0;;2 134 ;;PSOX("PATIENT STATUS");;0;;3 135 ;;PSOX("PROVIDER");;0;;4 136 ;;PSOX("CLINIC");;0;;5 137 ;;PSODRUG("IEN");;0;;6 138 ;;PSODRUG("TRADE NAME");;TN;;1 139 ;;PSOX("QTY");;0;;7 140 ;;PSOX("DAYS SUPPLY");;0;;8 141 ;;PSOX("# OF REFILLS");;0;;9 142 ;;PSOX("COPIES");;0;;18 143 ;;PSOX("MAIL/WINDOW");;0;;11 144 ;;PSOX("REMARKS");;3;;7 145 ;;PSOX("CLERK CODE");;0;;16 146 ;;PSODRUG("COST");;0;;17 147 ;;PSOSITE;;2;;9 148 ;;PSOX("LOGIN DATE");;2;;1 149 ;;PSOX("FILL DATE");;2;;2 150 ;;PSOX("PHARMACIST");;2;;3 151 ;;PSOX("LOT #");;2;;4 152 ;;PSOX("DISPENSED DATE");;2;;5 153 ;;PSOX("STOP DATE");;2;;6 154 ;;PSODRUG("NDC");;2;;7 155 ;;PSODRUG("DAW");;EPH;;1 156 ;;PSODRUG("MANUFACTURER");;2;;8 157 ;;PSOX("EXPIRATION DATE");;2;;11 158 ;;PSOX("GENERIC PROVIDER");;2;;12 159 ;;PSOX("RELEASED DATE/TIME");;2;;13 160 ;;PSOX("METHOD OF PICK-UP");;MP;;1 161 ;;PSOX("STATUS");;STA;;1 162 ;;PSOX("LAST DISPENSED DATE");;3;;1 163 ;;PSOX("NEXT POSSIBLE REFILL");;3;;2 164 ;;PSOX("COSIGNING PROVIDER");;3;;3 165 ;;PSOX("TYPE OF RX");;TYPE;;1 166 ;;PSOX("SAND");;SAND;;1 167 ;;PSOX("POE");;POE;;1 168 ;;PSOX("INS");;INS;;1 1 PSON52 ;BIR/DSD - files new entries in prescription file ;08/09/93 2 ;;7.0;OUTPATIENT PHARMACY;**1,16,23,27,32,46,71,111,124,117,131,139,157,143,219,148,239,201,268,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 ^PS(55 supported by DBIA 2228 20 ;External reference to PSOUL^PSSLOCK supported by DBIA 2789 21 ;External reference to ^XUSEC supported by DBIA 10076 22 ;External reference SWSTAT^IBBAPI supported by DBIA 4663 23 EN(PSOX) ;Entry Point 24 START ; 25 D:$D(XRTL) T0^%ZOSV ; Start RT Monitor 26 D INIT G:PSON52("QFLG") END D NFILE Q:$G(PSONEW("DFLG")) D PS55,DIK 27 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; Stop RT Monitor 28 D FINISH 29 I $P(^PSRX(PSOX("IRXN"),0),"^",11)="W",$G(^("IB")) S ^PSRX("ACP",$P(^PSRX(PSOX("IRXN"),0),"^",2),$P(^(2),"^",2),0,PSOX("IRXN"))="" 30 END D EOJ 31 Q 32 INIT ; 33 K X,%DT S:$G(PSOID) PSOX("ISSUE DATE")=PSOID 34 S PSOX("CS")=0 35 F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)="" I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S $P(PSOX("CS"),"^")=1 S:$E(+PSODRUG("DEA"),DEA)=2 $P(PSOX("CS"),"^",2)=1 36 S PSON52("QFLG")=0,X1=PSOX("ISSUE DATE"),X2=PSOX("DAYS SUPPLY")*(PSOX("# OF REFILLS")+1)\1 37 I $D(CLOZPAT) S X2=$S(X2=14:14,X2=7:7,1:X2) G DT 38 S X2=$S(PSOX("DAYS SUPPLY")=X2:X2,+$G(PSOX("CS")):184,+$G(DEA("CS")):184,1:366) 39 I X2<30 D 40 . N % S %=$P($G(PSORX("PATIENT STATUS")),"^"),X2=30 41 . S:%?.N %=$P($G(^PS(53,+%,0)),"^") I %["AUTH ABS" S X2=5 42 DT D C^%DTC S PSOX("STOP DATE")=$P(X,".") K X 43 I PSOX("# OF REFILLS")>0 S X1=PSOX("FILL DATE"),X2=$S((PSOX("DAYS SUPPLY")-10\1)<1:1,1:PSOX("DAYS SUPPLY")-10\1) D C^%DTC S PSOX("NEXT POSSIBLE REFILL")=$P(X,".") K X 44 S PSOX("TYPE OF RX")=0,PSOX("DISPENSED DATE")=PSOX("FILL DATE") D NOW^%DTC S PSOX("LOGIN DATE")=$S($P($G(OR0),"^",12):$P($G(OR0),"^",12),1:%) K %,X 45 S PSOX("STATUS")=$S($G(PSOX("STATUS"))]"":PSOX("STATUS"),$D(PSORX("VERIFY")):1,1:0) 46 S PSOX("COPIES")=$S($G(PSOX("COPIES"))]"":PSOX("COPIES"),1:1) 47 I $G(PSORX("PHARM"))]"" S PSOX("PHARMACIST")=PSORX("PHARM") K PSORX("PHARM") 48 INITX Q 49 ; 50 NFILE I $G(OR0) D Q:$G(PSONEW("DFLG")) 51 .D NOOR^PSONEW Q:$G(PSONEW("DFLG")) 52 .I $G(PSOSIGFL)!($G(PSODRUG("OI"))'=$P(OR0,"^",8)) S PSONEW("CLERK CODE")=DUZ,PSONEW("REMARKS")=$G(PSONEW("REMARKS"))_" CPRS Order #"_$P(OR0,"^")_" Edited." 53 S DIC="^PSRX(",DLAYGO=52,DIC(0)="L",X=PSOX("RX #") K DD,DO D FILE^DICN S PSOX("IRXN")=+Y K DLAYGO,X,Y,DIC,DD,DO D:+$G(DGI) TECH^PSODGDGI 54 F PSOX1=0:1 S PSON52=$P($T(DD+PSOX1),";;",2,4) Q:PSON52="" K PSOY S PSOY=$P(PSON52,";;") I $G(@PSOY)]"" S $P(PSON52(PSOX("IRXN"),$P(PSON52,";;",2)),"^",$P(PSON52,";;",3))=@PSOY 55 F I=1:1:PSOX("ENT") S ^PSRX(PSOX("IRXN"),6,I,0)=PSOX("DOSE",I)_"^"_$G(PSOX("DOSE ORDERED",I))_"^"_$G(PSOX("UNITS",I))_"^"_$G(PSOX("NOUN",I))_"^" D 56 .S ^PSRX(PSOX("IRXN"),6,I,0)=^PSRX(PSOX("IRXN"),6,I,0)_$G(PSOX("DURATION",I))_"^"_$G(PSOX("CONJUNCTION",I))_"^"_$G(PSOX("ROUTE",I))_"^"_$G(PSOX("SCHEDULE",I))_"^"_$G(PSOX("VERB",I)) 57 .I $G(PSOX("ODOSE",I))]"" S ^PSRX(PSOX("IRXN"),6,I,1)=PSOX("ODOSE",I) 58 S ^PSRX(PSOX("IRXN"),6,0)="^52.0113^"_PSOX("ENT")_"^"_PSOX("ENT") 59 K PSOX1,PSOY 60 S PSOX1="" F S PSOX1=$O(PSON52(PSOX("IRXN"),PSOX1)) Q:PSOX1="" S ^PSRX(PSOX("IRXN"),PSOX1)=$G(PSON52(PSOX("IRXN"),PSOX1)) 61 I $O(PSOX("SIG",0)) D 62 .S D=0 F S D=$O(PSOX("SIG",D)) Q:'D S ^PSRX(PSOX("IRXN"),"INS1",D,0)=PSOX("SIG",D),TP=$G(TP)+1 63 .S ^PSRX(PSOX("IRXN"),"INS1",0)="^52.0115^"_TP_"^"_TP_"^"_DT_"^^" K TP,D 64 I $G(PSOX("SINS"))]"" S ^PSRX(PSOX("IRXN"),"INSS")=PSOX("SINS") 65 I $G(SIGOK) D 66 .S $P(^PSRX(PSOX("IRXN"),"SIG"),"^",2)=1,^PSRX(PSOX("IRXN"),"SIG1",0)="^52.04A^^" 67 .S D=0 F S D=$O(SIG(D)) Q:'D S ^PSRX(PSOX("IRXN"),"SIG1",D,0)=SIG(D),$P(^PSRX(PSOX("IRXN"),"SIG1",0),"^",3)=+$P(^PSRX(PSOX("IRXN"),"SIG1",0),"^",3)+1,$P(^(0),"^",4)=+$P(^(0),"^",4)+1 Q:'$O(SIG(D)) 68 .K SIG 69 I $D(PSOINSFL) S ^PSRX(PSOX("IRXN"),"A",0)="^52.3DA^1^1",^PSRX(PSOX("IRXN"),"A",1,0)=DT_"^G^^0^Patient Instructions "_$S(PSOINSFL=1:"",1:"Not ")_"Sent By Provider." 70 I $G(OR0) S:$P(OR0,"^",24) ^PSRX(PSOX("IRXN"),"PKI")=1 71 K PSOX1,PSOFINFL,HLDSIG,D,PSOINSFL,D 72 D:$G(^TMP("PSODAI",$J,0)) 73 .S $P(^PSRX(PSOX("IRXN"),3),"^",6)=1 74 .I $O(^TMP("PSODAI",$J,0)) S DAI=0 F S DAI=$O(^TMP("PSODAI",$J,DAI)) Q:'DAI D 75 ..S:'$D(^PSRX(PSOX("IRXN"),"DAI",0)) ^PSRX(PSOX("IRXN"),"DAI",0)="^52.03^^" S ^PSRX(PSOX("IRXN"),"DAI",DAI,0)=^TMP("PSODAI",$J,DAI,0) 76 ..S $P(^PSRX(PSOX("IRXN"),"DAI",0),"^",3)=+$P(^PSRX(PSOX("IRXN"),"DAI",0),"^",3)+1,$P(^(0),"^",4)=+$P(^(0),"^",4)+1 77 .K ^TMP("PSODAI",$J),DAI 78 I $G(PSOX("CHCS NUMBER"))'="" S $P(^PSRX(PSOX("IRXN"),"EXT"),"^")=$G(PSOX("CHCS NUMBER")) 79 I $G(PSOX("EXTERNAL SYSTEM"))'="" S $P(^PSRX(PSOX("IRXN"),"EXT"),"^",2)=$G(PSOX("EXTERNAL SYSTEM")) 80 I $G(PSOX("NEWCOPAY")) S ^PSRX(PSOX("IRXN"),"IB")=$G(PSOX("NEWCOPAY")) 81 ;Next line, set SC question based on Copay status? 82 IBQ ;I $G(PSOBILL)=2 S ^PSRX(PSOX("IRXN"),"IBQ")=$S($G(PSOX("NEWCOPAY")):0,1:1) 83 I $G(PSOAFYN)="Y" S PSOSCP="" ;vfah 84 N PSOSCFLD S PSOSCFLD=$S(PSOSCP'="":$G(PSOANSQ("SC")),1:"")_"^"_$G(PSOANSQ("MST"))_"^"_$G(PSOANSQ("VEH"))_"^"_$G(PSOANSQ("RAD"))_"^"_$G(PSOANSQ("PGW"))_"^"_$G(PSOANSQ("HNC"))_"^"_$G(PSOANSQ("CV")) 85 I PSOSCP<50&($TR(PSOSCFLD,"^")'="")&($P($G(^PS(53,+$G(PSONEW("PATIENT STATUS")),0)),"^",7)'=1) D 86 . S ^PSRX(PSOX("IRXN"),"IBQ")=PSOSCFLD K PSOSCFLD ;don't set if SC % is null or 0, just set it in ICD node 87 D ICD^PSODIAG 88 D:$$SWSTAT^IBBAPI() GACT^PSOPFSU0(PSOX("IRXN"),0) 89 K PSOANSQ,PSOANSQD,PSOX("NEWCOPAY") 90 L -^PSRX("B",PSOX("IRXN")) 91 Q 92 ; 93 PS55 ; 94 L +^PS(55,PSODFN,"P"):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) 95 S:'$D(^PS(55,PSODFN,"P",0)) ^(0)="^55.03PA^^" 96 F PSOX1=$P(^PS(55,PSODFN,"P",0),"^",3):1 Q:'$D(^PS(55,PSODFN,"P",PSOX1)) 97 S PSOX("55 IEN")=PSOX1 98 S ^PS(55,PSODFN,"P",PSOX1,0)=PSOX("IRXN"),$P(^PS(55,PSODFN,"P",0),"^",3,4)=PSOX1_"^"_($P(^PS(55,PSODFN,"P",0),"^",4)+1) 99 S ^PS(55,PSODFN,"P","A",PSONEW("STOP DATE"),PSOX("IRXN"))="" 100 PS55X L -^PS(55,PSODFN,"P") 101 K PSOX1 102 Q 103 DIK ; 104 I $D(^XUSEC("PSORPH",DUZ)) S DA=PSOX("IRXN"),DIE=52,DR="41////"_PSOCOU_";S:'X Y=""@1"";42////"_PSOCOUU_";@1" D ^DIE K DIE,DR 105 K DIK,DA S DIK="^PSRX(",DA=PSOX("IRXN") D IX1^DIK K DIK 106 S DA=PSOX("IRXN") D ORC^PSORN52C 107 Q 108 FINISH ; 109 ANQ I $G(ANQDATA)]"" D NOW^%DTC G:$D(^PS(52.52,"B",%)) ANQ D 110 .K DD,DO S DIC="^PS(52.52,",DIC(0)="L",DLAYGO=52.52,X=% D FILE^DICN K DIC,DLAYGO,DD,DO 111 .S ^PS(52.52,+Y,0)=$P(Y,"^",2)_"^"_PSOX("IRXN")_"^"_ANQDATA,^PS(52.52,"A",PSOX("IRXN"),+Y)="" K ANQDATA,X,Y,%,ANQREM 112 G:PSOX("STATUS")=4 FINISHP 113 I $D(PSORX("VERIFY")) D G FINISHX 114 .K DIC,DLAYGO,DINUM,DIADD,X,DD,DO S DIC="^PS(52.4,",DLAYGO=52.4,DINUM=PSOX("IRXN"),DIC(0)="ML",X=PSOX("IRXN") 115 .D FILE^DICN K DD,DO,DIC,DLAYGO,DINUM S ^PS(52.4,PSOX("IRXN"),0)=PSOX("IRXN")_"^"_PSODFN_"^"_DUZ_"^"_"^"_$E(PSOX("LOGIN DATE"),1,7)_"^"_PSOX("IRXN")_"^"_PSOX("STOP DATE") 116 .K DIK,DA S DIK="^PS(52.4,",DA=PSOX("IRXN") D IX^DIK K DIK,DA 117 ; 118 I PSOX("FILL DATE")>DT,$P(PSOPAR,"^",6) S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=0 D SUS^PSORXL K DA G FINISHX 119 ; 120 ; - Calling ECME for claims generation and transmission / REJECT handling 121 N ACTION 122 I $$SUBMIT^PSOBPSUT(PSOX("IRXN"),0) D I ACTION="Q"!(ACTION="^") Q 123 . S ACTION="" D ECMESND^PSOBPSU1(PSOX("IRXN"),0,PSOX("FILL DATE"),"OF") 124 . I $$FIND^PSOREJUT(PSOX("IRXN"),0) D 125 . . S ACTION=$$HDLG^PSOREJU1(PSOX("IRXN"),0,"79,88","OF","IOQ","I") 126 ; 127 FINISHP ; 128 I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSOX("IRXN")_",",RXFL(PSOX("IRXN"))=0 G FINISHX 129 F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 130 I $L(PSORX("PSOL",PSOX2))+$L(PSOX("IRXN"))<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_"," 131 E S PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_"," 132 S RXFL(PSOX("IRXN"))=0 133 FINISHX ;call to build Rx array for bingo board 134 I $G(PSORX("MAIL/WINDOW"))["W" S BINGCRT=1,BINGRTE="W",BBFLG=1 D BBRX^PSORN52C 135 K PSOX1,PSOX2 136 Q 137 EOJ ; 138 ;B xref locked in routine PSONRXN 139 L -^PSRX("B",PSOX("IRXN")) K OTHDOS,DA,PSON52,PSOPRC,RTE,SCH,PSOX("INS"),PSONEW("INS"),PSORXED("INS"),PSONEW("ENT"),PSORXED("ENT"),OLENT 140 D PSOUL^PSSLOCK(PSOX("IRXN")) 141 Q 142 ; 143 ;;PSOX("SIG");;SIG;;1 144 DD ;;PSOX("RX #");;0;;1 145 ;;PSOX("ISSUE DATE");;0;;13 146 ;;PSODFN;;0;;2 147 ;;PSOX("PATIENT STATUS");;0;;3 148 ;;PSOX("PROVIDER");;0;;4 149 ;;PSOX("CLINIC");;0;;5 150 ;;PSODRUG("IEN");;0;;6 151 ;;PSODRUG("TRADE NAME");;TN;;1 152 ;;PSOX("QTY");;0;;7 153 ;;PSOX("DAYS SUPPLY");;0;;8 154 ;;PSOX("# OF REFILLS");;0;;9 155 ;;PSOX("COPIES");;0;;18 156 ;;PSOX("MAIL/WINDOW");;0;;11 157 ;;PSOX("REMARKS");;3;;7 158 ;;PSOX("CLERK CODE");;0;;16 159 ;;PSODRUG("COST");;0;;17 160 ;;PSOSITE;;2;;9 161 ;;PSOX("LOGIN DATE");;2;;1 162 ;;PSOX("FILL DATE");;2;;2 163 ;;PSOX("PHARMACIST");;2;;3 164 ;;PSOX("LOT #");;2;;4 165 ;;PSOX("DISPENSED DATE");;2;;5 166 ;;PSOX("STOP DATE");;2;;6 167 ;;PSODRUG("NDC");;2;;7 168 ;;PSODRUG("DAW");;EPH;;1 169 ;;PSODRUG("MANUFACTURER");;2;;8 170 ;;PSOX("EXPIRATION DATE");;2;;11 171 ;;PSOX("GENERIC PROVIDER");;2;;12 172 ;;PSOX("RELEASED DATE/TIME");;2;;13 173 ;;PSOX("METHOD OF PICK-UP");;MP;;1 174 ;;PSOX("STATUS");;STA;;1 175 ;;PSOX("LAST DISPENSED DATE");;3;;1 176 ;;PSOX("NEXT POSSIBLE REFILL");;3;;2 177 ;;PSOX("COSIGNING PROVIDER");;3;;3 178 ;;PSOX("TYPE OF RX");;TYPE;;1 179 ;;PSOX("SAND");;SAND;;1 180 ;;PSOX("POE");;POE;;1 181 ;;PSOX("INS");;INS;;1
Note:
See TracChangeset
for help on using the changeset viewer.
