- 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/PSOORED7.m
r613 r623 1 PSOORED7 ;ISC-BHAM/MFR-edit orders from backdoor con't ;03/06/95 10:24 2 ;;7.0;OUTPATIENT PHARMACY;**148,247,281**;DEC 1997;Build 41 3 ;called from psooredt. cmop edit checks. 4 ;Reference to file #50 supported by IA 221 5 ;Reference to $$ECMEON^BPSUTIL supported by IA 4410 6 ;Reference to $$DIVNCPDP^BPSBUTL supported by IA 4719 7 ; 8 NOCHG S CMRL=1 D CHK1^PSOORED2 I '$G(CMRL) W !,"No editing allowed of "_$S(FLN=9:"Day Supply",FLN=10:"Quantity",1:"# of Refills")_" (CMOP)." D PAUSE^VALM1 K CMRL Q 9 K CMRL,DIC,DIQ 10 S DIC=52,DA=PSORXED("IRXN"),DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ 11 S PSORXED($S(FLN=9:"DAYS SUPPLY",FLN=10:"QTY",1:"# OF REFILLS"))=PSORXED(52,DA,DR) 12 D:'$O(PSORXED("DOSE",0)) DOLST^PSOORED3 13 I FLN=9 D Q 14 .D DAYS^PSODIR1(.PSORXED) I $G(PSORXED("DFLG")) K PSORXED("FLD",8) Q 15 .S PSORXED("FLD",8)=PSORXED("DAYS SUPPLY") 16 I FLN=10 D Q 17 .D QTY^PSODIR1(.PSORXED) I $G(PSORXED("DFLG")) K PSORXED("FLD",7) Q 18 .S:$G(PSORXED("QTY")) PSORXED("FLD",7)=PSORXED("QTY") 19 I FLN=11 D Q 20 .S X=$G(PSORXED("PATIENT STATUS")) S:'X X=$P(RX0,"^",3) 21 .S DIC=53,DIC(0)="QXZ" D ^DIC K DIC 22 .S:+Y PSORXED("PTST NODE")=Y(0) 23 .S:'$G(PSORXED("PATIENT STATUS")) PSORXED("PATIENT STATUS")=+Y 24 .K X,Y 25 .I $G(PSODRUG("IEN"))=$P(RX0,"^",6) K PSODRUG S X="`"_$P(RX0,"^",6),DIC=50,DIC(0)="QXZ" D ^DIC K PSOY S PSOY=Y,PSOY(0)=Y(0) D SET^PSODRG 26 .S:'$G(PSORXED("DAYS SUPPLY")) PSORXED("DAYS SUPPLY")=$P(RX0,"^",8) 27 .F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),1,I)) Q:'I S RFTT=$G(RFTT)+1 28 .D REFILL^PSODIR1(.PSORXED) K RFTT 29 .I $G(PSORXED("DFLG")) K PSORXED("FLD",9) Q 30 .I PSORXED("# OF REFILLS")=$P(RX0,"^",9) Q 31 .S PSORXED("FLD",9)=PSORXED("# OF REFILLS") 32 Q 33 VER ;checks for changes to dosing instructions 34 S ENTS=0 35 F I=0:0 S I=$O(PSORXED("DOSE",I)) Q:'I S ENTS=$G(ENTS)+1 36 I ENTS<OLENT!(ENTS>OLENT) S PSOSIGFL=1 Q 37 F I=1:1:OLENT D:$D(^PSRX(PSORXED("IRXN"),6,I,0)) 38 .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^")'=PSORXED("DOSE",I) S PSOSIGFL=1 39 .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^")=PSORXED("DOSE",I) D 40 ..I $G(PSORXED("DOSE ORDERED",I)) S:PSORXED("DOSE ORDERED",I)'=$P(^PSRX(PSORXED("IRXN"),6,I,0),"^",2) PSOSIGFL=1 41 .I $G(PSORXED("DURATION",I))]"" D 42 ..S DURATION=$S($E($P(^PSRX(PSORXED("IRXN"),6,I,0),"^",5),1)'?.N:$E($P(^PSRX(PSORXED("IRXN"),6,I,0),"^",5),2,99)_$E($P(^PSRX(PSORXED("IRXN"),6,I,0),"^",5),1),1:$P(^PSRX(PSORXED("IRXN"),6,I,0),"^",5)) 43 ..I +DURATION'=+$G(PSORXED("DURATION",I)) S PSOSIGFL=1 44 .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",6)'=$G(PSORXED("CONJUNCTION",I)) S PSOSIGFL=1 45 .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",7)'=$G(PSORXED("ROUTE",I)) S PSOSIGFL=1 46 .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",8)'=PSORXED("SCHEDULE",I) S PSOSIGFL=1 47 .I $G(^PSRX(PSORXED("IRXN"),6,I,1))'=$G(PSORXED("ODOSE",I)) S PSOSIGFL=1 48 K DURATION 49 Q 50 ; 51 RESUB ; Resubmits 3rd party claim in case of an edit (Original) 52 N CHANGED S CHANGED=$$CHANGED(PSORXED("IRXN"),.FLDS) 53 I CHANGED D 54 . N RX S RX=PSORXED("IRXN") Q:'RX 55 . I $P(CHANGED,"^",2),'$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,0)) D Q 56 . . D REVERSE^PSOBPSU1(RX,0,"DC",99,"RX DIVISION CHANGED",1) 57 . I $$SUBMIT^PSOBPSUT(RX,0,1,1) D 58 . . I '$P(CHANGED,"^",2),$$STATUS^PSOBPSUT(RX,0)="" Q 59 . . D ECMESND^PSOBPSU1(RX,0,,"ED",$$GETNDC^PSONDCUT(RX,0),,$S($P(CHANGED,"^",2):"RX DIVISION CHANGED",1:"RX EDITED"),,+$G(CHGNDC)) 60 . . ;- Checking/Handling DUR/79 Rejects 61 . . I $$FIND^PSOREJUT(RX,0) S X=$$HDLG^PSOREJU1(RX,0,"79,88","ED","IOQ","Q") 62 Q 63 ; 64 CHANGED(RX,PRIOR) ; - Check if fields have changed and should for 3rd Party Claim resubmission 65 ;Input: (r) RX - Rx IEN 66 ; (r) PRIOR - Array with fields 67 ;Output: CHANGED - 0 - Not changed / 1 - Original Rx field changed ^ Rx Division changed (1 - YES) 68 N CHANGED,SAVED 69 S CHANGED=0 D GETS^DIQ(52,RX_",","4;7;8;20;22;27;81","I","SAVED") 70 F I=4,7,8,22,27,81 D I CHANGED Q 71 . I $G(PRIOR(52,RX_",",I,"I"))'=$G(SAVED(52,RX_",",I,"I")) S CHANGED=1 Q 72 I $$DIVNCPDP^BPSBUTL(+$G(PRIOR(52,RX_",",20,"I")))'=$$DIVNCPDP^BPSBUTL(+$G(SAVED(52,RX_",",20,"I"))) S CHANGED="1^1" 73 Q CHANGED 74 ;; 75 NDCDAWDE(ST,FLN,RXN) ; allow edit of NDC & DAW for DC'd/expired ECME RXs 76 ;; input: (r) ST - the Rx status code 77 ;; (r) FLN - field number selected for editing 78 ;; (r) RXN - prescription # 79 ;; output: VALMSG for inappropriate field selection or use 80 ;; PSODRUG & RSORXED arrays updated if edited 81 Q:$G(ST)=""!($G(FLN)="")!($G(RXN)="") 82 I '((ST=11)!(ST=12)) S VALMSG=("Invalid selection!") Q 83 I '((FLN=2)!(FLN=20)!(FLN=21)) S VALMSG=("Invalid selection!") Q 84 I $$STATUS^PSOBPSUT(RXN,$$LSTRFL^PSOBPSU1(RXN))="" S VALMSG=("Invalid selection!") Q 85 ; 86 ; edit NDCs 87 I FLN=2 D Q 88 .N NDC 89 .S NDC=$$GETNDC^PSONDCUT(RXN,0) 90 .D NDCEDT^PSONDCUT(RXN,"",$G(DRG),$G(PSOSITE),.NDC) 91 .I $G(NDC)="^" Q 92 .S (PSODRUG("NDC"),PSORXED("FLD",27))=NDC 93 ;; 94 ; edit refill NDCs/DAWs 95 I FLN=20 D Q 96 .I $$LSTRFL^PSOBPSU1(RXN)=0 S VALMSG="Invalid selection!" Q 97 .D REF^PSOORED2 98 ;; 99 ; edit DAW 100 I FLN=21 D Q 101 .N DAW 102 .D EDTDAW^PSODAWUT(RXN,0,.DAW) 103 .I $G(DAW)="^" Q 104 .S (PSODRUG("DAW"),PSORXED("FLD",81))=DAW 105 Q 106 ;; 1 PSOORED7 ;ISC-BHAM/MFR-edit orders from backdoor con't ;03/06/95 10:24 2 ;;7.0;OUTPATIENT PHARMACY;**148,247**;DEC 1997;Build 18 3 ;called from psooredt. cmop edit checks. 4 ;Reference to file #50 supported by IA 221 5 ;Reference to $$ECMEON^BPSUTIL supported by IA 4410 6 ;Reference to $$DIVNCPDP^BPSBUTL supported by IA 4719 7 ; 8 NOCHG S CMRL=1 D CHK1^PSOORED2 I '$G(CMRL) W !,"No editing allowed of "_$S(FLN=9:"Day Supply",FLN=10:"Quantity",1:"# of Refills")_" (CMOP)." D PAUSE^VALM1 K CMRL Q 9 K CMRL,DIC,DIQ 10 S DIC=52,DA=PSORXED("IRXN"),DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ 11 S PSORXED($S(FLN=9:"DAYS SUPPLY",FLN=10:"QTY",1:"# OF REFILLS"))=PSORXED(52,DA,DR) 12 D:'$O(PSORXED("DOSE",0)) DOLST^PSOORED3 13 I FLN=9 D Q 14 .D DAYS^PSODIR1(.PSORXED) I $G(PSORXED("DFLG")) K PSORXED("FLD",8) Q 15 .S PSORXED("FLD",8)=PSORXED("DAYS SUPPLY") 16 I FLN=10 D Q 17 .D QTY^PSODIR1(.PSORXED) I $G(PSORXED("DFLG")) K PSORXED("FLD",7) Q 18 .S:$G(PSORXED("QTY")) PSORXED("FLD",7)=PSORXED("QTY") 19 I FLN=11 D Q 20 .S X=$G(PSORXED("PATIENT STATUS")) S:'X X=$P(RX0,"^",3) 21 .S DIC=53,DIC(0)="QXZ" D ^DIC K DIC 22 .S:+Y PSORXED("PTST NODE")=Y(0) 23 .S:'$G(PSORXED("PATIENT STATUS")) PSORXED("PATIENT STATUS")=+Y 24 .K X,Y 25 .I $G(PSODRUG("IEN"))=$P(RX0,"^",6) K PSODRUG S X="`"_$P(RX0,"^",6),DIC=50,DIC(0)="QXZ" D ^DIC K PSOY S PSOY=Y,PSOY(0)=Y(0) D SET^PSODRG 26 .S:'$G(PSORXED("DAYS SUPPLY")) PSORXED("DAYS SUPPLY")=$P(RX0,"^",8) 27 .F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),1,I)) Q:'I S RFTT=$G(RFTT)+1 28 .D REFILL^PSODIR1(.PSORXED) K RFTT 29 .I $G(PSORXED("DFLG")) K PSORXED("FLD",9) Q 30 .I PSORXED("# OF REFILLS")=$P(RX0,"^",9) Q 31 .S PSORXED("FLD",9)=PSORXED("# OF REFILLS") 32 Q 33 VER ;checks for changes to dosing instructions 34 S ENTS=0 35 F I=0:0 S I=$O(PSORXED("DOSE",I)) Q:'I S ENTS=$G(ENTS)+1 36 I ENTS<OLENT!(ENTS>OLENT) S PSOSIGFL=1 Q 37 F I=1:1:OLENT D:$D(^PSRX(PSORXED("IRXN"),6,I,0)) 38 .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^")'=PSORXED("DOSE",I) S PSOSIGFL=1 39 .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^")=PSORXED("DOSE",I) D 40 ..I $G(PSORXED("DOSE ORDERED",I)) S:PSORXED("DOSE ORDERED",I)'=$P(^PSRX(PSORXED("IRXN"),6,I,0),"^",2) PSOSIGFL=1 41 .I $G(PSORXED("DURATION",I))]"" D 42 ..S DURATION=$S($E($P(^PSRX(PSORXED("IRXN"),6,I,0),"^",5),1)'?.N:$E($P(^PSRX(PSORXED("IRXN"),6,I,0),"^",5),2,99)_$E($P(^PSRX(PSORXED("IRXN"),6,I,0),"^",5),1),1:$P(^PSRX(PSORXED("IRXN"),6,I,0),"^",5)) 43 ..I +DURATION'=+$G(PSORXED("DURATION",I)) S PSOSIGFL=1 44 .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",6)'=$G(PSORXED("CONJUNCTION",I)) S PSOSIGFL=1 45 .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",7)'=$G(PSORXED("ROUTE",I)) S PSOSIGFL=1 46 .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",8)'=PSORXED("SCHEDULE",I) S PSOSIGFL=1 47 .I $G(^PSRX(PSORXED("IRXN"),6,I,1))'=$G(PSORXED("ODOSE",I)) S PSOSIGFL=1 48 K DURATION 49 Q 50 ; 51 RESUB ; Resubmits 3rd party claim in case of an edit (Original) 52 N CHANGED S CHANGED=$$CHANGED(PSORXED("IRXN"),.FLDS) 53 I CHANGED D 54 . N RX S RX=PSORXED("IRXN") Q:'RX 55 . I $P(CHANGED,"^",2),'$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,0)) D Q 56 . . D REVERSE^PSOBPSU1(RX,0,"DC",99,"RX DIVISION CHANGED",1) 57 . I $$SUBMIT^PSOBPSUT(RX,0,1,1) D 58 . . I '$P(CHANGED,"^",2),$$STATUS^PSOBPSUT(RX,0)="" Q 59 . . D ECMESND^PSOBPSU1(RX,0,,"ED",$$GETNDC^PSONDCUT(RX,0),,$S($P(CHANGED,"^",2):"RX DIVISION CHANGED",1:"RX EDITED"),,+$G(CHGNDC)) 60 . . ;- Checking/Handling DUR/79 Rejects 61 . . I $$FIND^PSOREJUT(RX,0) S X=$$HDLG^PSOREJU1(RX,0,"79,88","ED","IOQ","I") 62 Q 63 ; 64 CHANGED(RX,PRIOR) ; - Check if fields have changed and should for 3rd Party Claim resubmission 65 ;Input: (r) RX - Rx IEN 66 ; (r) PRIOR - Array with fields 67 ;Output: CHANGED - 0 - Not changed / 1 - Original Rx field changed ^ Rx Division changed (1 - YES) 68 N CHANGED,SAVED 69 S CHANGED=0 D GETS^DIQ(52,RX_",","4;7;8;20;22;27;81","I","SAVED") 70 F I=4,7,8,22,27,81 D I CHANGED Q 71 . I $G(PRIOR(52,RX_",",I,"I"))'=$G(SAVED(52,RX_",",I,"I")) S CHANGED=1 Q 72 I $$DIVNCPDP^BPSBUTL(+$G(PRIOR(52,RX_",",20,"I")))'=$$DIVNCPDP^BPSBUTL(+$G(SAVED(52,RX_",",20,"I"))) S CHANGED="1^1" 73 Q CHANGED
Note:
See TracChangeset
for help on using the changeset viewer.
