- 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/PSOR52.m
r613 r623 1 PSOR52 2 ;;7.0;OUTPATIENT PHARMACY;**10,22,27,181,148,201,260,281**;DEC 1997;Build 41 3 4 5 6 7 8 9 10 EN(PSOX) 11 START 12 13 14 15 16 17 18 END 19 20 21 22 INIT 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 INITX 41 42 FILE 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 DIK 59 60 61 62 63 64 65 FINISH 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 . . S ACTION=$$HDLG^PSOREJU1(PSOERX,PSOERF,"79,88","OF","IOQ","Q")87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 FINISHX 103 104 105 106 EOJ 107 108 109 110 111 112 113 DD 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 1 PSOR52 ;IHS/DSD/JCM - Files refill entries in prescription file ;03/10/93 2 ;;7.0;OUTPATIENT PHARMACY;**10,22,27,181,148,201,260**;DEC 1997;Build 84 3 ;Reference to ^PSDRUG supported by DBIA 221 4 ;Reference to PSOUL^PSSLOCK supported by DBIA 2789 5 ;Reference SWSTAT^IBBAPI supported by DBIA 4663 6 ;Reference SAVNDC^PSSNDCUT supported by DBIA 4707 7 ; This routine is responsible for the actual 8 ; filling of the refill prescription. 9 ;--------------------------------------------------------- 10 EN(PSOX) ;Entry Point 11 START ; 12 D:$D(XRTL) T0^%ZOSV ; Start RT monitor 13 D INIT G:PSOR52("QFLG") END 14 D FILE 15 D DIK 16 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; Stop RT Monitor 17 D FINISH 18 END D EOJ 19 Q 20 ;--------------------------------------------------------- 21 ; 22 INIT ; 23 S PSOR52("QFLG")=0 24 S PSOX("QTY")=$P(PSOX("RX0"),"^",7),PSOX("DAYS SUPPLY")=$P(PSOX("RX0"),"^",8) 25 S:$G(^PSDRUG($P(PSOX("RX0"),"^",6),660))]"" PSOX("COST")=$P(^PSDRUG($P(PSOX("RX0"),"^",6),660),"^",6) 26 D NOW^%DTC S PSOX("LOGIN DATE")=$E(%,1,7) 27 S X1=PSOX("FILL DATE"),X2=PSOX("DAYS SUPPLY")-10\1 D C^%DTC S PSOX1=X 28 S X1=$P(PSOX("RX2"),"^",2) 29 S X2=PSOX("DAYS SUPPLY")*(PSOX("NUMBER")+1)-10\1 30 D C^%DTC S PSOX2=X 31 S PSOX("NEXT POSSIBLE REFILL")=$S(PSOX1>PSOX2:PSOX1,1:PSOX2) 32 K X,PSOX1,PSOX2 33 S (PSOX("LAST DISPENSED DATE"),PSOX("DISPENSED DATE"))=PSOX("FILL DATE") 34 I PSOX("FILL DATE")>$S($G(PSOX("LOGIN DATE")):$E(PSOX("LOGIN DATE"),1,7),1:DT),$P(PSOPAR,"^",6) D 35 .S PSOX("OLD MAIL/WINDOW")=$S($G(PSOX("MAIL/WINDOW"))]"":PSOX("MAIL/WINDOW"),1:"MAIL"),PSOX("MAIL/WINDOW")="M" 36 I $P(PSOX("RX2"),"^",12)]"" S PSOX("GENERIC PROVIDER")=$P(PSOX("RX2"),"^",12) 37 S PSOX("PROVIDER")=$P(PSOX("RX0"),"^",4) 38 S:'$D(PSOX("CLERK CODE")) PSOX("CLERK CODE")=DUZ 39 S PSOX("DAW")=$$GETDAW^PSODAWUT(+PSOX("IRXN")),PSOX("NDC")=$$GETNDC^PSSNDCUT($P(PSOX("RX0"),"^",6)) 40 INITX Q 41 ; 42 FILE ; 43 ;L +^PSRX(PSOX("IRXN")):0 44 I '$D(^PSRX(PSOX("IRXN"),1,0)) S ^(0)="^52.1DA^1^1" 45 E S ^PSRX(PSOX("IRXN"),1,0)=$P(^PSRX(PSOX("IRXN"),1,0),"^",1,2)_"^"_PSOX("NUMBER")_"^"_($P(^(0),"^",4)+1) 46 F PSOX1=1:1 S PSOR52=$P($T(DD+PSOX1),";;",2,4) Q:PSOR52="" K PSOY S PSOY=$P(PSOR52,";;") I $D(@PSOY) S $P(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),$P(PSOR52,";;",2)),"^",$P(PSOR52,";;",3))=@PSOY 47 K PSOX1,PSOY 48 S PSOX1="" F S PSOX1=$O(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1)) Q:PSOX1="" S ^PSRX(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1)=$G(PSOR52(PSOX("IRXN"),1,PSOX("NUMBER"),PSOX1)) 49 K PSOX1 50 S:PSOX("STA")=6 $P(^PSRX(PSOX("IRXN"),"STA"),"^")=0 51 S $P(^PSRX(PSOX("IRXN"),3),"^",1,2)=PSOX("LAST DISPENSED DATE")_"^"_PSOX("NEXT POSSIBLE REFILL") 52 S $P(^PSRX(PSOX("IRXN"),3),"^",4)=PSOX("LAST REFILL DATE") 53 I $D(PSOX("METHOD OF PICK-UP")),PSOX("FILL DATE")'>DT S $P(^PSRX(PSOX("IRXN"),"MP"),"^")=PSOX("METHOD OF PICK-UP") 54 D:$$SWSTAT^IBBAPI() GACT^PSOPFSU0(PSOX("IRXN"),PSOX("NUMBER")) 55 ;L -^PSRX(PSOX("IRXN")) 56 Q 57 ; 58 DIK ; 59 K DIK,DA 60 S DIK="^PSRX(",DA=PSOX("IRXN") D IX1^DIK K DIK 61 I +$G(^PSRX(DA,"IB")),$P(^PSRX(DA,1,PSOX("NUMBER"),0),"^",2)="W" S ^PSRX("ACP",$P(^PSRX(DA,0),"^",2),$P(^PSRX(DA,1,PSOX("NUMBER"),0),"^"),PSOX("NUMBER"),DA)="" K DA 62 D:$T(EN^PSOHDR)]"" EN^PSOHDR("PREF",PSOX("IRXN")) 63 Q 64 ; 65 FINISH ; 66 I $G(PSOX("QS"))="S" D G FINISHX 67 . S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=PSOX("NUMBER") 68 . D SUS^PSORXL K DA 69 ; 70 ; - Previous ePharmacy Refill was Deleted and a new one is being entered 71 I '$$SUBMIT^PSOBPSUT(PSOX("IRXN"),PSOX("NUMBER")),$$STATUS^PSOBPSUT(PSOX("IRXN"),PSOX("NUMBER"))'="" D 72 . D RETRXF^PSOREJU2(PSOX("IRXN"),PSOX("NUMBER"),1) 73 ; 74 I PSOX("FILL DATE")>$S($G(PSOX("LOGIN DATE")):$E(PSOX("LOGIN DATE"),1,7),1:DT),$P(PSOPAR,"^",6) D G FINISHX 75 .K PSOXRXFL I $D(RXFL(PSOX("IRXN"))) S PSOXRXFL=$G(RXFL(PSOX("IRXN"))) 76 .S DA=PSOX("IRXN"),RXFL(PSOX("IRXN"))=PSOX("NUMBER") 77 .D SUS^PSORXL K DA 78 .I $G(PSOXRXFL)'="" S RXFL(PSOX("IRXN"))=$G(PSOXRXFL) K PSOXRXFL 79 ; 80 ; - Calling ECME for claims generation and transmission / REJECT handling 81 N ACTION,PSOERX,PSOERF 82 S PSOERX=PSOX("IRXN"),PSOERF=PSOX("NUMBER") 83 I $$SUBMIT^PSOBPSUT(PSOERX,PSOERF) D I ACTION="Q"!(ACTION="^") Q 84 . S ACTION="" D ECMESND^PSOBPSU1(PSOERX,PSOERF,PSOX("FILL DATE"),"RF") 85 . I $$FIND^PSOREJUT(PSOERX,PSOERF) D 86 . . S ACTION=$$HDLG^PSOREJU1(PSOERX,PSOERF,"79,88","OF","IOQ","I") 87 . I $$STATUS^PSOBPSUT(PSOERX,PSOERF)="E PAYABLE" D 88 . . D SAVNDC^PSSNDCUT(+$$GET1^DIQ(52,PSOERX,6,"I"),$G(PSOSITE),$$GETNDC^PSONDCUT(PSOERX,PSOERF)) 89 ; 90 I $G(PSOX("QS"))="Q" D G FINISHX 91 . I $G(PPL),$L(PPL_PSOX("IRXN")_",")>240 D TRI^PSOBBC D Q^PSORXL K PPL,RXFL 92 . S RXFL(PSOX("IRXN"))=PSOX("NUMBER") 93 . I $G(PPL) S PPL=PPL_PSOX("IRXN")_"," 94 . E S PPL=PSOX("IRXN")_"," 95 ; 96 I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSOX("IRXN")_",",RXFL(PSOX("IRXN"))=PSOX("NUMBER") G FINISHX 97 F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1 98 I $L(PSORX("PSOL",PSOX2))+$L(PSOX("IRXN"))<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSOX("IRXN")_"," 99 E S PSORX("PSOL",PSOX2+1)=PSOX("IRXN")_"," 100 S RXFL(PSOX("IRXN"))=PSOX("NUMBER") 101 ; 102 FINISHX ; 103 I $G(PSORX("MAIL/WINDOW"))["W" S BINGCRT=1,BINGRTE="W",BBFLG=1 D BBRX^PSORN52C 104 K PSOX1,PSOX2 105 Q 106 EOJ ; 107 I $D(PSOX("OLD MAIL/WINDOW")) S PSOX("MAIL/WINDOW")=PSOX("OLD MAIL/WINDOW") K PSOX("OLD MAIL/WINDOW") 108 S DA=$O(^PS(52.41,"ARF",PSOX("IRXN"),0)) I DA D S DIK="^PS(52.41," D ^DIK 109 .S PSORFKL=DA D PSOUL^PSSLOCK(PSORFKL_"S") K PSORFKL 110 K PSOR52,DA,DIK 111 Q 112 ; 113 DD ;rx data nodes 114 ;;PSOX("PROVIDER");;0;;17 115 ;;PSOX("QTY");;0;;4 116 ;;PSOX("DAYS SUPPLY");;0;;10 117 ;;PSOX("MAIL/WINDOW");;0;;2 118 ;;PSOX("REMARKS");;0;;3 119 ;;PSOX("CLERK CODE");;0;;7 120 ;;PSOX("COST");;0;;11 121 ;;PSOSITE;;0;;9 122 ;;PSOX("LOGIN DATE");;0;;8 123 ;;PSOX("FILL DATE");;0;;1 124 ;;PSOX("PHARMACIST");;0;;5 125 ;;PSOX("LOT #");;0;;6 126 ;;PSOX("DISPENSED DATE");;0;;19 127 ;;PSOX("NDC");;1;;3 128 ;;PSOX("DAW");;EPH;;1 129 ;;PSOX("MANUFACTURER");;0;;14 130 ;;PSOX("EXPIRATION DATE");;0;;15 131 ;;PSOX("GENERIC PROVIDER");;1;;1 132 ;;PSOX("RELEASED DATE/TIME");;0;;18
Note:
See TracChangeset
for help on using the changeset viewer.
