- 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/PSOORED2.m
r613 r623 1 PSOORED2 ;ISC-BHAM/SAB-edit orders from backdoor con't ;03/06/95 10:24 2 ;;7.0;OUTPATIENT PHARMACY;**2,51,46,78,102,114,117,133,159,148,247,260,281**;DEC 1997;Build 41 3 ;Reference to $$DIVNCPDP^BPSBUTL supported by IA 4719 4 ;Reference to $$ECMEON^BPSUTIL supported by IA 4410 5 ;called from psooredt. cmop edit checks. 6 Q 7 ISDT D CHK K RF I $G(CMRL) W !,"Released by CMOP. No editing allowed on Issue Date." D PAUSE^VALM1 K CMRL Q 8 S %DT="AEX",%DT(0)=-$P(^PSRX(DA,2),"^",2),Y=$P(RX0,"^",13) X ^DD("DD") S %DT("A")="ISSUE DATE: ",%DT("B")=Y D ^%DT I "^"[$E(X) K X,Y,%DT,DTOUT,DUOUT Q 9 G:Y=-1 ISDT S PSORXED("FLD",1)=Y 10 ;S DR="1///"_Y,DIE=52 D ^DIE 11 D KV K X,Y,%DT 12 Q 13 FLDT D CHK K RF I $G(CMRL) W !,"Released by CMOP. No editing allowed on Fill Date." D PAUSE^VALM1 K CMRL Q 14 D KV S Y=$P(^PSRX(DA,2),"^",2) X ^DD("DD") S DIR("A")="FILL DATE",DIR("B")=Y 15 S DIR(0)="D^"_$P(RX0,"^",13)_":"_$P(PSORXED("RX2"),"^",6)_":EX" 16 S DIR("?",1)="The earliest fill date allowed is determined by the Issue Date,",DIR("?",2)="the Fill Date cannot be before the Issue Date or past the Expiration Date." 17 S DIR("?")="Both the month and day are required." D ^DIR 18 I $D(DIRUT) D KV K PSORXED("FLD",22),X,Y Q 19 S PSORXED("FLD",22)=Y ;S DR="22R///"_Y,DIE=52 D ^DIE 20 K X,Y 21 KV K DIR,DUOUT,DTOUT,DIRUT 22 Q 23 CHK I $D(^PSRX("AR",+$P(PSORXED("RX2"),"^",13),PSORXED("IRXN"))) S CMRL=1 Q 24 F RF=0:0 S RF=$O(^PSRX(PSORXED("IRXN"),1,RF)) Q:'RF I $D(^PSRX("AR",+$P(^PSRX(PSORXED("IRXN"),1,RF,0),"^",18),PSORXED("IRXN"))) S CMRL=1 25 Q 26 CHK1 I +^PSRX(PSORXED("IRXN"),"STA")=5 D Q:'$G(CMRL) 27 .S SURX=$O(^PS(52.5,PSORXED("IRXN"),0)) Q:'SURX I $P(^PS(52.5,SURX,0),"^",7)']""!($P(^(0),"^",7)="Q") S CMRL=1 28 .E S CMRL=0 29 F FEV=0:0 S FEV=$O(^PSRX(PSORXED("IRXN"),4,FEV)) Q:'FEV I '$P(^PSRX(PSORXED("IRXN"),4,FEV,0),"^",3),$P(^(0),"^",4)<3 S CMRL=0 30 Q 31 REF ;shows refill info 32 S RFN=0 F N=0:0 S N=$O(^PSRX(PSORXED("IRXN"),1,N)) Q:'N S RFM=N,RFN=RFN+1 33 ;G:RFM=1 SRF 34 W ! K DA,DR D KV S DIR(0)="Y",DIR("B")="No",DIR("A")="There "_$S(RFN>1:"are ",1:"is ")_RFN_" refill"_$S(RFN>1:"s.",1:".")_" Do you want to edit" 35 D ^DIR D KV Q:'Y 36 SRF W !!,"# Log Date Refill Date Qty Routing Lot # Pharmacist",! F I=1:1:80 W "=" 37 F N=0:0 S N=$O(^PSRX(PSORXED("IRXN"),1,N)) Q:'N S P1=^(N,0) D 38 .S DTT=$P(P1,"^",8)\1 D DAT S LOG=DAT,DTT=$P(P1,"^"),$P(RN," ",10)=" " D DAT 39 .W !,N_" "_LOG_" "_DAT_" "_$P(P1,"^",4)_$E(" ",$L($P(P1,"^",4))+1,15)_" "_$S($P(P1,"^",2)="M":"MAIL ",1:"WINDOW")_" "_$P(P1,"^",6)_$E(RN,$L($P(P1,"^",6))+1,12) 40 .W $E($S($D(^VA(200,+$P(P1,"^",5),0)):$P(^(0),"^"),1:""),1,16) 41 .S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"Unknown") W !,"Division: "_PSDIV_$E(" ",$L(PSDIV)+1,8)_" " 42 .W "Dispensed: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:"")_" " 43 .S RTS=$S($P(P1,"^",16):" Returned to Stock: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" Released: "_$S($P(P1,"^",18):$E($P(P1,"^",18),4,5)_"/"_$E($P(P1,"^",18),6,7)_"/"_$E($P(P1,"^",18),2,3),1:"")) 44 .W RTS W:$P(P1,"^",3)]"" !," Remarks: "_$P(P1,"^",3) 45 S DA(1)=PSORXED("IRXN") I RFN=1 S Y=RFM G RFM 46 W ! D KV S DIR("A")="Select a Refill",DIR(0)="NO^1:"_RFM_":0" D ^DIR Q:$D(DIRUT) 47 RFM I '$D(^PSRX(PSORXED("IRXN"),1,Y,0)) W !,$C(7),"Invalid selection.",! G SRF 48 S CMRL=0 I $D(^PSRX("AR",+$P(^PSRX(PSORXED("IRXN"),1,Y,0),"^",18),PSORXED("IRXN"),Y)) S CMRL=1 G RFX 49 F FEV=0:0 S FEV=$O(^PSRX(PSORXED("IRXN"),4,FEV)) Q:'FEV I $P(^PSRX(PSORXED("IRXN"),4,FEV,0),"^",3)=Y,$P(^(0),"^",4)<3 S CMRL=1 50 RFX N RFL,NDC,DAW,FLDS,QUIT,CHGNDC,CHANGED 51 W ! S DA=Y,DIE="^PSRX("_DA(1)_",1,",DR=$S('CMRL:".01;1.1",1:"1.2:5;8") 52 D GETS^DIQ(52.1,DA_","_DA(1)_",",".01;1;1.1;8;11;81","I","FLDS") 53 S:$D(^PSRX(DA(1),1,DA,0)) PSORXED("RX1")=^PSRX(DA(1),1,DA,0),(RFED,RFL)=DA 54 I $G(ST)=11!($G(ST)=12),$$STATUS^PSOBPSUT(PSORXED("IRXN"),RFL)'="" S QUIT=0 D RFE Q ;short circuit for DC'd/Expired ECME RXs 55 D ^DIE S QUIT=$D(Y) K FEV,RFN,RFM,X,Y,DR 56 I '$G(DA) D REVERSE^PSOBPSU1(PSORXED("IRXN"),RFL,"DE",5) K CMRL,RFED D:$D(PSORX("PSOL"))&($G(DI)=.01) RFD Q 57 I 'CMRL,'QUIT S DR="1;1.2:5;8" D ^DIE S QUIT=$D(Y) 58 RFE I '$D(^PSRX(PSORXED("IRXN"),1,RFL)) Q 59 I 'QUIT,$$STATUS^PSOBPSUT(PSORXED("IRXN"),RFL)'="" D 60 . S NDC=$$GETNDC^PSONDCUT(PSORXED("IRXN"),RFL) 61 . D EDTDAW^PSODAWUT(PSORXED("IRXN"),RFL,.DAW) I $G(DAW)="^" Q 62 . D SAVDAW^PSODAWUT(PSORXED("IRXN"),RFL,+$G(DAW)) 63 . D NDC^PSODRG(PSORXED("IRXN"),RFL,,.NDC) I $G(NDC)="^",$G(NDC)="" Q 64 . I NDC'=$$GETNDC^PSONDCUT(PSORXED("IRXN"),RFL) D 65 . . S CHGNDC=1 D RXACT^PSOBPSU2(PSORXED("IRXN"),RFL,"NDC changed from "_$$GETNDC^PSONDCUT(PSORXED("IRXN"),RFL)_" to "_NDC_".","E") 66 . D SAVNDC^PSONDCUT(PSORXED("IRXN"),RFL,NDC) 67 S CHANGED=$$CHANGED(PSORXED("IRXN"),RFL,.FLDS) 68 I CHANGED D 69 . I $P(CHANGED,"^",2),'$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(PSORXED("IRXN"),RFL)) D Q 70 . . D REVERSE^PSOBPSU1(PSORXED("IRXN"),RFL,"DC",99,"REFILL DIVISION CHANGED",1) 71 . I $$SUBMIT^PSOBPSUT(PSORXED("IRXN"),RFL,1,1) D 72 . . N RX S RX=PSORXED("IRXN") 73 . . I '$P(CHANGED,"^",2),$$STATUS^PSOBPSUT(RX,RFL)="" Q 74 . . D ECMESND^PSOBPSU1(RX,RFL,,"ED",$$GETNDC^PSONDCUT(RX,RFL),,$S($P(CHANGED,"^",2):"REFILL DIVISION CHANGED",1:"REFILL EDITED"),,+$G(CHGNDC)) 75 . . ;- Checking/Handling DUR/79 Rejects 76 . . I $$FIND^PSOREJUT(RX,RFL) S X=$$HDLG^PSOREJU1(RX,RFL,"79,88","ED","IOQ","Q") 77 K DIE,CMRL,DA,DR 78 Q 79 CHANGED(RX,RFL,PRIOR) ; - Check if fields have changed and should for 3rd Party Claim resubmission 80 ;Input: (r) RX - Rx IEN 81 ; (r) RFL - Refill # 82 ; (r) PRIOR - Array with fields 83 ;Output: CHANGED - 0 - Not changed / 1 - Refill field changed ^ Rx Division changed (1 - YES) 84 N CHANGED,SAVED 85 S CHANGED=0 D GETS^DIQ(52.1,RFL_","_RX_",",".01;1;1.1;8;11;81","I","SAVED") 86 F I=.01,1,1.1,11,81 I $G(PRIOR(52.1,RFL_","_RX_",",I,"I"))'=$G(SAVED(52.1,RFL_","_RX_",",I,"I")) S CHANGED=1 Q 87 I $$DIVNCPDP^BPSBUTL(+$G(PRIOR(52.1,RFL_","_RX_",",8,"I")))'=$$DIVNCPDP^BPSBUTL(+$G(SAVED(52.1,RFL_","_RX_",",8,"I"))) S CHANGED="1^1" 88 Q CHANGED 89 ; 90 DAT S DAT="",DTT=DTT\1 Q:DTT'?7N S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3) 91 Q 92 DIE S DIE=52 D ^DIE I $D(Y) S PSORXED("DFLG")=1 93 K DIE,DR,X,Y 94 Q 95 RFD ;check for deleted refill 96 M PSOZ1("PSOL")=PSORX("PSOL") N I,J,K,PSOX2,PSOX3,PSOX9 S (I,K)=0 D 97 .F S I=$O(PSOZ1("PSOL",I)) Q:'I!(K) S PSOX2=PSOZ1("PSOL",I) I PSOX2[(PSORXED("IRXN")_",") S PSOX9="" D 98 ..F J=1:1 S PSOX3=$P(PSOX2,",",J) Q:'PSOX3 D 99 ...I 'K,PSOX3=PSORXED("IRXN") S K=1 100 ...E S PSOX9=PSOX9_$S('PSOX9:"",1:",")_PSOX3 101 ..I K S:PSOX9]"" PSORX("PSOL",I)=PSOX9_"," K:PSOX9="" PSORX("PSOL",I) 102 K PSOZ1("PSOL") 103 Q 104 EDTDOSE ;edit med instructions fields 105 I '$O(^PSRX(PSORXED("IRXN"),6,0)) D DOSE^PSOORED5 Q 106 D ^PSOORED3 107 Q 108 UPD ;updates dosing array 109 S HENT=ENT 110 UPD1 I $G(PSORXED("CONJUNCTION",(HENT+1)))]"",'$D(PSORXED("DOSE",(HENT+2))) K PSORXED("CONJUNCTION",(HENT+1)) Q 111 I $G(PSORXED("CONJUNCTION",(HENT+1)))]"" S PSORXED("CONJUNCTION",HENT)=PSORXED("CONJUNCTION",(HENT+1)) D G UPD1 112 .K PSORXED("CONJUNCTION",(HENT+1)) 113 .F Q:'$D(PSORXED("DOSE",(HENT+2))) D 114 ..S PSORXED("DOSE",(HENT+1))=PSORXED("DOSE",(HENT+2)) 115 ..S PSORXED("DOSE ORDERED",(HENT+1))=$G(PSORXED("DOSE ORDERED",(HENT+2))) 116 ..S PSORXED("UNITS",(HENT+1))=$G(PSORXED("UNITS",(HENT+2))) 117 ..S PSORXED("NOUN",(HENT+1))=$G(PSORXED("NOUN",(HENT+2))) 118 ..S PSORXED("DURATION",(HENT+1))=$G(PSORXED("DURATION",(HENT+2))) 119 ..S PSORXED("CONJUNCTION",(HENT+1))=$G(PSORXED("CONJUNCTION",(HENT+2))) 120 ..S PSORXED("ROUTE",(HENT+1))=$G(PSORXED("ROUTE",(HENT+2))) 121 ..S PSORXED("SCHEDULE",(HENT+1))=$G(PSORXED("SCHEDULE",(HENT+2))) 122 ..S PSORXED("ODOSE",(HENT+1))=$G(PSORXED("ODOSE",(HENT+2))) 123 ..S HENT=HENT+1 124 ..I $G(PSORXED("CONJUNCTION",(HENT+2)))]"" Q 125 ..K PSORXED("UNITS",(HENT+1)),PSORXED("NOUN",(HENT+1)),PSORXED("DURATION",(HENT+1)),PSORXED("CONJUNCTION",(HENT+1)),PSORXED("ROUTE",(HENT+1)),PSORXED("SCHEDULE",(HENT+1)),PSORXED("DOSE",(HENT+1)),PSORXED("DOSE ORDERED",(HENT+1)) 126 ..K PSORXED("VERB",(HENT+1)),PSORXED("ODOSE",(HENT+1)) 127 S PSORXED("ENT")=HENT K HENT,SENT D EN^PSOFSIG(.PSORXED) 128 Q 129 UPD2 I $G(PSORXED("CONJUNCTION",(HENT+1)))]"",'$D(PSORXED("DOSE",(HENT+2))) K PSORXED("CONJUNCTION",(HENT+1)) Q 130 I $G(PSORXED("CONJUNCTION",(HENT+1)))]"" S PSORXED("CONJUNCTION",HENT)=PSORXED("CONJUNCTION",(HENT+1)) D G UPD1 131 .K PSORXED("CONJUNCTION",(HENT+1)) I $D(PSORXED("DOSE",(HENT+2))) D 132 ..S PSORXED("DOSE",(HENT+1))=PSORXED("DOSE",(HENT+2)) 133 ..S PSORXED("DOSE ORDERED",(HENT+1))=$G(PSORXED("DOSE ORDERED",(HENT+2))) 134 ..S PSORXED("UNITS",(HENT+1))=$G(PSORXED("UNITS",(HENT+2))) 135 ..S PSORXED("NOUN",(HENT+1))=$G(PSORXED("NOUN",(HENT+2))) 136 ..S PSORXED("VERB",(HENT+1))=$G(PSORXED("VERB",(HENT+2))) 137 ..S PSORXED("DURATION",(HENT+1))=$G(PSORXED("DURATION",(HENT+2))) 138 ..S PSORXED("CONJUNCTION",(HENT+1))=$G(PSORXED("CONJUNCTION",(HENT+2))) 139 ..S PSORXED("ROUTE",(HENT+1))=$G(PSORXED("ROUTE",(HENT+2))) 140 ..S PSORXED("SCHEDULE",(HENT+1))=$G(PSORXED("SCHEDULE",(HENT+2))) 141 ..S PSORXED("ODOSE",(HENT+1))=$G(PSORXED("ODOSE",(HENT+2))) 142 ..S HENT=HENT+1 143 ..I $G(PSORXED("CONJUNCTION",(HENT+1)))]"" Q 144 ..K PSORXED("UNITS",(HENT+1)),PSORXED("NOUN",(HENT+1)),PSORXED("DURATION",(HENT+1)),PSORXED("ROUTE",(HENT+1)),PSORXED("SCHEDULE",(HENT+1)),PSORXED("DOSE",(HENT+1)),PSORXED("DOSE ORDERED",(HENT+1)),PSORXED("VERB",(HENT+1)) 145 ..K PSORXED("ODOSE",(HENT+1)) 146 F I=0:0 S I=$O(PSORXED("DOSE",I)) Q:'I S SENT=$G(SENT)+1 147 S PSORXED("ENT")=SENT K HENT,SENT D EN^PSOFSIG(.PSORXED) 148 Q 1 PSOORED2 ;ISC-BHAM/SAB-edit orders from backdoor con't ;03/06/95 10:24 2 ;;7.0;OUTPATIENT PHARMACY;**2,51,46,78,102,114,117,133,159,148,247,260**;DEC 1997;Build 84 3 ;Reference to $$DIVNCPDP^BPSBUTL supported by IA 4719 4 ;Reference to $$ECMEON^BPSUTIL supported by IA 4410 5 ;called from psooredt. cmop edit checks. 6 Q 7 ISDT D CHK K RF I $G(CMRL) W !,"Released by CMOP. No editing allowed on Issue Date." D PAUSE^VALM1 K CMRL Q 8 S %DT="AEX",%DT(0)=-$P(^PSRX(DA,2),"^",2),Y=$P(RX0,"^",13) X ^DD("DD") S %DT("A")="ISSUE DATE: ",%DT("B")=Y D ^%DT I "^"[$E(X) K X,Y,%DT,DTOUT,DUOUT Q 9 G:Y=-1 ISDT S PSORXED("FLD",1)=Y 10 ;S DR="1///"_Y,DIE=52 D ^DIE 11 D KV K X,Y,%DT 12 Q 13 FLDT D CHK K RF I $G(CMRL) W !,"Released by CMOP. No editing allowed on Fill Date." D PAUSE^VALM1 K CMRL Q 14 D KV S Y=$P(^PSRX(DA,2),"^",2) X ^DD("DD") S DIR("A")="FILL DATE",DIR("B")=Y 15 S DIR(0)="D^"_$P(RX0,"^",13)_":"_$P(PSORXED("RX2"),"^",6)_":EX" 16 S DIR("?",1)="The earliest fill date allowed is determined by the Issue Date,",DIR("?",2)="the Fill Date cannot be before the Issue Date or past the Expiration Date." 17 S DIR("?")="Both the month and day are required." D ^DIR 18 I $D(DIRUT) D KV K PSORXED("FLD",22),X,Y Q 19 S PSORXED("FLD",22)=Y ;S DR="22R///"_Y,DIE=52 D ^DIE 20 K X,Y 21 KV K DIR,DUOUT,DTOUT,DIRUT 22 Q 23 CHK I $D(^PSRX("AR",+$P(PSORXED("RX2"),"^",13),PSORXED("IRXN"))) S CMRL=1 Q 24 F RF=0:0 S RF=$O(^PSRX(PSORXED("IRXN"),1,RF)) Q:'RF I $D(^PSRX("AR",+$P(^PSRX(PSORXED("IRXN"),1,RF,0),"^",18),PSORXED("IRXN"))) S CMRL=1 25 Q 26 CHK1 I +^PSRX(PSORXED("IRXN"),"STA")=5 D Q:'$G(CMRL) 27 .S SURX=$O(^PS(52.5,PSORXED("IRXN"),0)) Q:'SURX I $P(^PS(52.5,SURX,0),"^",7)']""!($P(^(0),"^",7)="Q") S CMRL=1 28 .E S CMRL=0 29 F FEV=0:0 S FEV=$O(^PSRX(PSORXED("IRXN"),4,FEV)) Q:'FEV I '$P(^PSRX(PSORXED("IRXN"),4,FEV,0),"^",3),$P(^(0),"^",4)<3 S CMRL=0 30 Q 31 REF ;shows refill info 32 S RFN=0 F N=0:0 S N=$O(^PSRX(PSORXED("IRXN"),1,N)) Q:'N S RFM=N,RFN=RFN+1 33 ;G:RFM=1 SRF 34 W ! K DA,DR D KV S DIR(0)="Y",DIR("B")="No",DIR("A")="There "_$S(RFN>1:"are ",1:"is ")_RFN_" refill"_$S(RFN>1:"s.",1:".")_" Do you want to edit" 35 D ^DIR D KV Q:'Y 36 SRF W !!,"# Log Date Refill Date Qty Routing Lot # Pharmacist",! F I=1:1:80 W "=" 37 F N=0:0 S N=$O(^PSRX(PSORXED("IRXN"),1,N)) Q:'N S P1=^(N,0) D 38 .S DTT=$P(P1,"^",8)\1 D DAT S LOG=DAT,DTT=$P(P1,"^"),$P(RN," ",10)=" " D DAT 39 .W !,N_" "_LOG_" "_DAT_" "_$P(P1,"^",4)_$E(" ",$L($P(P1,"^",4))+1,15)_" "_$S($P(P1,"^",2)="M":"MAIL ",1:"WINDOW")_" "_$P(P1,"^",6)_$E(RN,$L($P(P1,"^",6))+1,12) 40 .W $E($S($D(^VA(200,+$P(P1,"^",5),0)):$P(^(0),"^"),1:""),1,16) 41 .S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"Unknown") W !,"Division: "_PSDIV_$E(" ",$L(PSDIV)+1,8)_" " 42 .W "Dispensed: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:"")_" " 43 .S RTS=$S($P(P1,"^",16):" Returned to Stock: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" Released: "_$S($P(P1,"^",18):$E($P(P1,"^",18),4,5)_"/"_$E($P(P1,"^",18),6,7)_"/"_$E($P(P1,"^",18),2,3),1:"")) 44 .W RTS W:$P(P1,"^",3)]"" !," Remarks: "_$P(P1,"^",3) 45 S DA(1)=PSORXED("IRXN") I RFN=1 S Y=RFM G RFM 46 W ! D KV S DIR("A")="Select a Refill",DIR(0)="NO^1:"_RFM_":0" D ^DIR Q:$D(DIRUT) 47 RFM I '$D(^PSRX(PSORXED("IRXN"),1,Y,0)) W !,$C(7),"Invalid selection.",! G SRF 48 S CMRL=0 I $D(^PSRX("AR",+$P(^PSRX(PSORXED("IRXN"),1,Y,0),"^",18),PSORXED("IRXN"),Y)) S CMRL=1 G RFX 49 F FEV=0:0 S FEV=$O(^PSRX(PSORXED("IRXN"),4,FEV)) Q:'FEV I $P(^PSRX(PSORXED("IRXN"),4,FEV,0),"^",3)=Y,$P(^(0),"^",4)<3 S CMRL=1 50 RFX N RFL,NDC,DAW,FLDS,QUIT,CHGNDC,CHANGED 51 W ! S DA=Y,DIE="^PSRX("_DA(1)_",1,",DR=$S('CMRL:".01;1.1",1:"1.2:5;8") 52 D GETS^DIQ(52.1,DA_","_DA(1)_",",".01;1;1.1;8;11;81","I","FLDS") 53 S:$D(^PSRX(DA(1),1,DA,0)) PSORXED("RX1")=^PSRX(DA(1),1,DA,0),(RFED,RFL)=DA 54 D ^DIE S QUIT=$D(Y) K FEV,RFN,RFM,X,Y,DR 55 I '$G(DA) D REVERSE^PSOBPSU1(PSORXED("IRXN"),RFL,"DE",5) K CMRL,RFED D:$D(PSORX("PSOL"))&($G(DI)=.01) RFD Q 56 I 'CMRL,'QUIT S DR="1;1.2:5;8" D ^DIE S QUIT=$D(Y) 57 I '$D(^PSRX(PSORXED("IRXN"),1,RFL)) Q 58 I 'QUIT,$$STATUS^PSOBPSUT(PSORXED("IRXN"),RFL)'="" D 59 . S NDC=$$GETNDC^PSONDCUT(PSORXED("IRXN"),RFL) 60 . D EDTDAW^PSODAWUT(PSORXED("IRXN"),RFL,.DAW) I $G(DAW)="^" Q 61 . D SAVDAW^PSODAWUT(PSORXED("IRXN"),RFL,+$G(DAW)) 62 . D NDC^PSODRG(PSORXED("IRXN"),RFL,,.NDC) I $G(NDC)="^",$G(NDC)="" Q 63 . I NDC'=$$GETNDC^PSONDCUT(PSORXED("IRXN"),RFL) D 64 . . S CHGNDC=1 D RXACT^PSOBPSU2(PSORXED("IRXN"),RFL,"NDC changed from "_$$GETNDC^PSONDCUT(PSORXED("IRXN"),RFL)_" to "_NDC_".","E") 65 . D SAVNDC^PSONDCUT(PSORXED("IRXN"),RFL,NDC) 66 S CHANGED=$$CHANGED(PSORXED("IRXN"),RFL,.FLDS) 67 I CHANGED D 68 . I $P(CHANGED,"^",2),'$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(PSORXED("IRXN"),RFL)) D Q 69 . . D REVERSE^PSOBPSU1(PSORXED("IRXN"),RFL,"DC",99,"REFILL DIVISION CHANGED",1) 70 . I $$SUBMIT^PSOBPSUT(PSORXED("IRXN"),RFL,1,1) D 71 . . N RX S RX=PSORXED("IRXN") 72 . . I '$P(CHANGED,"^",2),$$STATUS^PSOBPSUT(RX,RFL)="" Q 73 . . D ECMESND^PSOBPSU1(RX,RFL,,"ED",$$GETNDC^PSONDCUT(RX,RFL),,$S($P(CHANGED,"^",2):"REFILL DIVISION CHANGED",1:"REFILL EDITED"),,+$G(CHGNDC)) 74 . . ;- Checking/Handling DUR/79 Rejects 75 . . I $$FIND^PSOREJUT(RX,RFL) S X=$$HDLG^PSOREJU1(RX,RFL,"79,88","ED","IOQ","I") 76 K DIE,CMRL,DA,DR 77 Q 78 CHANGED(RX,RFL,PRIOR) ; - Check if fields have changed and should for 3rd Party Claim resubmission 79 ;Input: (r) RX - Rx IEN 80 ; (r) RFL - Refill # 81 ; (r) PRIOR - Array with fields 82 ;Output: CHANGED - 0 - Not changed / 1 - Refill field changed ^ Rx Division changed (1 - YES) 83 N CHANGED,SAVED 84 S CHANGED=0 D GETS^DIQ(52.1,RFL_","_RX_",",".01;1;1.1;8;11;81","I","SAVED") 85 F I=.01,1,1.1,11,81 I $G(PRIOR(52.1,RFL_","_RX_",",I,"I"))'=$G(SAVED(52.1,RFL_","_RX_",",I,"I")) S CHANGED=1 Q 86 I $$DIVNCPDP^BPSBUTL(+$G(PRIOR(52.1,RFL_","_RX_",",8,"I")))'=$$DIVNCPDP^BPSBUTL(+$G(SAVED(52.1,RFL_","_RX_",",8,"I"))) S CHANGED="1^1" 87 Q CHANGED 88 ; 89 DAT S DAT="",DTT=DTT\1 Q:DTT'?7N S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3) 90 Q 91 DIE S DIE=52 D ^DIE I $D(Y) S PSORXED("DFLG")=1 92 K DIE,DR,X,Y 93 Q 94 RFD ;check for deleted refill 95 M PSOZ1("PSOL")=PSORX("PSOL") N I,J,K,PSOX2,PSOX3,PSOX9 S (I,K)=0 D 96 .F S I=$O(PSOZ1("PSOL",I)) Q:'I!(K) S PSOX2=PSOZ1("PSOL",I) I PSOX2[(PSORXED("IRXN")_",") S PSOX9="" D 97 ..F J=1:1 S PSOX3=$P(PSOX2,",",J) Q:'PSOX3 D 98 ...I 'K,PSOX3=PSORXED("IRXN") S K=1 99 ...E S PSOX9=PSOX9_$S('PSOX9:"",1:",")_PSOX3 100 ..I K S:PSOX9]"" PSORX("PSOL",I)=PSOX9_"," K:PSOX9="" PSORX("PSOL",I) 101 K PSOZ1("PSOL") 102 Q 103 EDTDOSE ;edit med instructions fields 104 I '$O(^PSRX(PSORXED("IRXN"),6,0)) D DOSE^PSOORED5 Q 105 D ^PSOORED3 106 Q 107 UPD ;updates dosing array 108 S HENT=ENT 109 UPD1 I $G(PSORXED("CONJUNCTION",(HENT+1)))]"",'$D(PSORXED("DOSE",(HENT+2))) K PSORXED("CONJUNCTION",(HENT+1)) Q 110 I $G(PSORXED("CONJUNCTION",(HENT+1)))]"" S PSORXED("CONJUNCTION",HENT)=PSORXED("CONJUNCTION",(HENT+1)) D G UPD1 111 .K PSORXED("CONJUNCTION",(HENT+1)) 112 .F Q:'$D(PSORXED("DOSE",(HENT+2))) D 113 ..S PSORXED("DOSE",(HENT+1))=PSORXED("DOSE",(HENT+2)) 114 ..S PSORXED("DOSE ORDERED",(HENT+1))=$G(PSORXED("DOSE ORDERED",(HENT+2))) 115 ..S PSORXED("UNITS",(HENT+1))=$G(PSORXED("UNITS",(HENT+2))) 116 ..S PSORXED("NOUN",(HENT+1))=$G(PSORXED("NOUN",(HENT+2))) 117 ..S PSORXED("DURATION",(HENT+1))=$G(PSORXED("DURATION",(HENT+2))) 118 ..S PSORXED("CONJUNCTION",(HENT+1))=$G(PSORXED("CONJUNCTION",(HENT+2))) 119 ..S PSORXED("ROUTE",(HENT+1))=$G(PSORXED("ROUTE",(HENT+2))) 120 ..S PSORXED("SCHEDULE",(HENT+1))=$G(PSORXED("SCHEDULE",(HENT+2))) 121 ..S PSORXED("ODOSE",(HENT+1))=$G(PSORXED("ODOSE",(HENT+2))) 122 ..S HENT=HENT+1 123 ..I $G(PSORXED("CONJUNCTION",(HENT+2)))]"" Q 124 ..K PSORXED("UNITS",(HENT+1)),PSORXED("NOUN",(HENT+1)),PSORXED("DURATION",(HENT+1)),PSORXED("CONJUNCTION",(HENT+1)),PSORXED("ROUTE",(HENT+1)),PSORXED("SCHEDULE",(HENT+1)),PSORXED("DOSE",(HENT+1)),PSORXED("DOSE ORDERED",(HENT+1)) 125 ..K PSORXED("VERB",(HENT+1)),PSORXED("ODOSE",(HENT+1)) 126 S PSORXED("ENT")=HENT K HENT,SENT D EN^PSOFSIG(.PSORXED) 127 Q 128 UPD2 I $G(PSORXED("CONJUNCTION",(HENT+1)))]"",'$D(PSORXED("DOSE",(HENT+2))) K PSORXED("CONJUNCTION",(HENT+1)) Q 129 I $G(PSORXED("CONJUNCTION",(HENT+1)))]"" S PSORXED("CONJUNCTION",HENT)=PSORXED("CONJUNCTION",(HENT+1)) D G UPD1 130 .K PSORXED("CONJUNCTION",(HENT+1)) I $D(PSORXED("DOSE",(HENT+2))) D 131 ..S PSORXED("DOSE",(HENT+1))=PSORXED("DOSE",(HENT+2)) 132 ..S PSORXED("DOSE ORDERED",(HENT+1))=$G(PSORXED("DOSE ORDERED",(HENT+2))) 133 ..S PSORXED("UNITS",(HENT+1))=$G(PSORXED("UNITS",(HENT+2))) 134 ..S PSORXED("NOUN",(HENT+1))=$G(PSORXED("NOUN",(HENT+2))) 135 ..S PSORXED("VERB",(HENT+1))=$G(PSORXED("VERB",(HENT+2))) 136 ..S PSORXED("DURATION",(HENT+1))=$G(PSORXED("DURATION",(HENT+2))) 137 ..S PSORXED("CONJUNCTION",(HENT+1))=$G(PSORXED("CONJUNCTION",(HENT+2))) 138 ..S PSORXED("ROUTE",(HENT+1))=$G(PSORXED("ROUTE",(HENT+2))) 139 ..S PSORXED("SCHEDULE",(HENT+1))=$G(PSORXED("SCHEDULE",(HENT+2))) 140 ..S PSORXED("ODOSE",(HENT+1))=$G(PSORXED("ODOSE",(HENT+2))) 141 ..S HENT=HENT+1 142 ..I $G(PSORXED("CONJUNCTION",(HENT+1)))]"" Q 143 ..K PSORXED("UNITS",(HENT+1)),PSORXED("NOUN",(HENT+1)),PSORXED("DURATION",(HENT+1)),PSORXED("ROUTE",(HENT+1)),PSORXED("SCHEDULE",(HENT+1)),PSORXED("DOSE",(HENT+1)),PSORXED("DOSE ORDERED",(HENT+1)),PSORXED("VERB",(HENT+1)) 144 ..K PSORXED("ODOSE",(HENT+1)) 145 F I=0:0 S I=$O(PSORXED("DOSE",I)) Q:'I S SENT=$G(SENT)+1 146 S PSORXED("ENT")=SENT K HENT,SENT D EN^PSOFSIG(.PSORXED) 147 Q
Note:
See TracChangeset
for help on using the changeset viewer.
