PSOORED7 ;ISC-BHAM/MFR - edit orders from backdoor con't ;03/06/95 10:24
;;7.0;OUTPATIENT PHARMACY;**148,247,281,289,358,385,584,611,624,562**;DEC 1997;Build 19
;called from psooredt. cmop edit checks.
;Reference to file #50 supported by IA 221
;Reference to $$ECMEON^BPSUTIL supported by IA 4410
;Reference to $$DIVNCPDP^BPSBUTL supported by IA 4719
;
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
I FLN=11,$P($G(^PSRX(PSORXED("IRXN"),2)),U,13) W !,"No editing allowed of # of Refills for released prescription" D PAUSE^VALM1 K CMRL Q ;584
K CMRL,DIC,DIQ
S DIC=52,DA=PSORXED("IRXN"),DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ
S PSORXED($S(FLN=9:"DAYS SUPPLY",FLN=10:"QTY",1:"# OF REFILLS"))=PSORXED(52,DA,DR)
D:'$O(PSORXED("DOSE",0)) DOLST^PSOORED3
I FLN=9 D Q
.D DAYS^PSODIR1(.PSORXED) I $G(PSORXED("DFLG")) K PSORXED("FLD",8) Q
.S PSORXED("FLD",8)=PSORXED("DAYS SUPPLY")
.;PSO*7*611 Prompt the user for the Refills # so it will stay in sync with the Days Supply
.;PSO*7*624 Only prompt the user for the Refills # if a Clozapine flagged drug with at least 1 registered lab test
.I $D(^PSDRUG("ACLOZ",DRGIEN)),$D(^PSDRUG(DRGIEN,"CLOZ2",0)),$O(^PSDRUG(DRGIEN,"CLOZ2",0)),$D(^PSDRUG(DRGIEN,"CLOZ2",$O(^PSDRUG(DRGIEN,"CLOZ2",0)),0)) D
..D REFILL^PSODIR1(.PSORXED) I $G(PSORXED("DFLG")) K PSORXED("FLD",9) Q
..S PSORXED("FLD",9)=PSORXED("# OF REFILLS")
I FLN=10 D Q
.D QTY^PSODIR1(.PSORXED) I $G(PSORXED("DFLG")) K PSORXED("FLD",7) Q
.S:$G(PSORXED("QTY")) PSORXED("FLD",7)=PSORXED("QTY")
I FLN=11 D Q
.S X=$G(PSORXED("PATIENT STATUS")) S:'X X=$P(RX0,"^",3)
.S DIC=53,DIC(0)="QXZ" D ^DIC K DIC
.S:+Y PSORXED("PTST NODE")=Y(0)
.S:'$G(PSORXED("PATIENT STATUS")) PSORXED("PATIENT STATUS")=+Y
.K X,Y
.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
.S:'$G(PSORXED("DAYS SUPPLY")) PSORXED("DAYS SUPPLY")=$P(RX0,"^",8)
.F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),1,I)) Q:'I S RFTT=$G(RFTT)+1
.D REFILL^PSODIR1(.PSORXED) K RFTT
.I $G(PSORXED("DFLG")) K PSORXED("FLD",9) Q
.I PSORXED("# OF REFILLS")=$P(RX0,"^",9) Q
.S PSORXED("FLD",9)=PSORXED("# OF REFILLS")
Q
VER ;checks for changes to dosing instructions
S ENTS=0
F I=0:0 S I=$O(PSORXED("DOSE",I)) Q:'I S ENTS=$G(ENTS)+1
I ENTS<OLENT!(ENTS>OLENT) S PSOSIGFL=1 Q
F I=1:1:OLENT D:$D(^PSRX(PSORXED("IRXN"),6,I,0))
.I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^")'=PSORXED("DOSE",I) S PSOSIGFL=1
.I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^")=PSORXED("DOSE",I) D
..I $G(PSORXED("DOSE ORDERED",I)) S:PSORXED("DOSE ORDERED",I)'=$P(^PSRX(PSORXED("IRXN"),6,I,0),"^",2) PSOSIGFL=1
.I $G(PSORXED("DURATION",I))]"" D
..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))
..I +DURATION'=+$G(PSORXED("DURATION",I)) S PSOSIGFL=1
.I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",6)'=$G(PSORXED("CONJUNCTION",I)) S PSOSIGFL=1
.I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",7)'=$G(PSORXED("ROUTE",I)) S PSOSIGFL=1
.I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",8)'=PSORXED("SCHEDULE",I) S PSOSIGFL=1
.I $G(^PSRX(PSORXED("IRXN"),6,I,1))'=$G(PSORXED("ODOSE",I)) S PSOSIGFL=1
K DURATION
Q
;
RESUB ; Resubmits 3rd party claim in case of an edit (Original)
N CHANGED S CHANGED=$$CHANGED(PSORXED("IRXN"),.FLDS)
I CHANGED D
. N RX S RX=PSORXED("IRXN") Q:'RX
. I $P(CHANGED,"^",2),'$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,0)) D Q
. . D REVERSE^PSOBPSU1(RX,0,"DC",99,"RX DIVISION CHANGED",1)
. I $$SUBMIT^PSOBPSUT(RX,0,1,1) D
. . I '$P(CHANGED,"^",2),$$STATUS^PSOBPSUT(RX,0)="" Q
. . D ECMESND^PSOBPSU1(RX,0,,"ED",$$GETNDC^PSONDCUT(RX,0),,$S($P(CHANGED,"^",2):"RX DIVISION CHANGED",1:"RX EDITED"),,+$G(CHGNDC))
. . ; Quit if there is an unresolved TRICARE/CHAMPVA non-billable reject code, PSO*7*358
. . I $$PSOET^PSOREJP3(RX,0) S X="Q" Q
. . ;- Checking/Handling DUR/79 Rejects
. . I $$FIND^PSOREJUT(RX,0) S X=$$HDLG^PSOREJU1(RX,0,"79,88,943","ED","IOQ","Q")
Q
;
CHANGED(RX,PRIOR) ; - Check if fields have changed and should for 3rd Party Claim resubmission
;Input: (r) RX - Rx IEN
; (r) PRIOR - Array with fields
;Output: CHANGED - 0 - Not changed / 1 - Original Rx field changed ^ Rx Division changed (1 - YES)
N CHANGED,SAVED
S CHANGED=0 D GETS^DIQ(52,RX_",","4;7;8;20;22;27;81","I","SAVED")
F I=4,7,8,22,27,81 D I CHANGED Q
. I $G(PRIOR(52,RX_",",I,"I"))'=$G(SAVED(52,RX_",",I,"I")) S CHANGED=1 Q
I $$DIVNCPDP^BPSBUTL(+$G(PRIOR(52,RX_",",20,"I")))'=$$DIVNCPDP^BPSBUTL(+$G(SAVED(52,RX_",",20,"I"))) S CHANGED="1^1"
Q CHANGED
;;
NDCDAWDE(ST,FLN,RXN) ; allow edit of NDC & DAW for DC'd/expired ECME RXs
;; input: (r) ST - the Rx status code
;; (r) FLN - field number selected for editing
;; (r) RXN - prescription #
;; output: VALMSG for inappropriate field selection or use
;; PSODRUG & RSORXED arrays updated if edited
Q:$G(ST)=""!($G(FLN)="")!($G(RXN)="")
I '((ST=11)!(ST=12)!(ST=14)!(ST=15)) S VALMSG=("Invalid selection!") Q
I '((FLN=2)!(FLN=20)!(FLN=21)) S VALMSG=("Invalid selection!") Q
I $$STATUS^PSOBPSUT(RXN,$$LSTRFL^PSOBPSU1(RXN))="" S VALMSG=("Invalid selection!") Q
;
; edit NDCs
I FLN=2 D Q
.N NDC
.S NDC=$$GETNDC^PSONDCUT(RXN,0)
.D NDCEDT^PSONDCUT(RXN,"",$G(DRG),$G(PSOSITE),.NDC)
.I $G(NDC)="^" Q
.S (PSODRUG("NDC"),PSORXED("FLD",27))=NDC
;;
; edit refill NDCs/DAWs
I FLN=20 D Q
.I $$LSTRFL^PSOBPSU1(RXN)=0 S VALMSG="Invalid selection!" Q
.D REF^PSOORED2
;;
; edit DAW
I FLN=21 D Q
.N DAW
.D EDTDAW^PSODAWUT(RXN,0,.DAW)
.I $G(DAW)="^" Q
.S (PSODRUG("DAW"),PSORXED("FLD",81))=DAW
Q
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORED7 5884 printed Apr 09, 2024@21:30:35 Page 2
PSOORED7 ;ISC-BHAM/MFR - edit orders from backdoor con't ;03/06/95 10:24
+1 ;;7.0;OUTPATIENT PHARMACY;**148,247,281,289,358,385,584,611,624,562**;DEC 1997;Build 19
+2 ;called from psooredt. cmop edit checks.
+3 ;Reference to file #50 supported by IA 221
+4 ;Reference to $$ECMEON^BPSUTIL supported by IA 4410
+5 ;Reference to $$DIVNCPDP^BPSBUTL supported by IA 4719
+6 ;
NOCHG SET CMRL=1
DO CHK1^PSOORED2
IF '$GET(CMRL)
WRITE !,"No editing allowed of "_$SELECT(FLN=9:"Day Supply",FLN=10:"Quantity",1:"# of Refills")_" (CMOP)."
DO PAUSE^VALM1
KILL CMRL
QUIT
+1 ;584
IF FLN=11
IF $PIECE($GET(^PSRX(PSORXED("IRXN"),2)),U,13)
WRITE !,"No editing allowed of # of Refills for released prescription"
DO PAUSE^VALM1
KILL CMRL
QUIT
+2 KILL CMRL,DIC,DIQ
+3 SET DIC=52
SET DA=PSORXED("IRXN")
SET DIQ="PSORXED"
DO EN^DIQ1
KILL DIC,DIQ
+4 SET PSORXED($SELECT(FLN=9:"DAYS SUPPLY",FLN=10:"QTY",1:"# OF REFILLS"))=PSORXED(52,DA,DR)
+5 if '$ORDER(PSORXED("DOSE",0))
DO DOLST^PSOORED3
+6 IF FLN=9
Begin DoDot:1
+7 DO DAYS^PSODIR1(.PSORXED)
IF $GET(PSORXED("DFLG"))
KILL PSORXED("FLD",8)
QUIT
+8 SET PSORXED("FLD",8)=PSORXED("DAYS SUPPLY")
+9 ;PSO*7*611 Prompt the user for the Refills # so it will stay in sync with the Days Supply
+10 ;PSO*7*624 Only prompt the user for the Refills # if a Clozapine flagged drug with at least 1 registered lab test
+11 IF $DATA(^PSDRUG("ACLOZ",DRGIEN))
IF $DATA(^PSDRUG(DRGIEN,"CLOZ2",0))
IF $ORDER(^PSDRUG(DRGIEN,"CLOZ2",0))
IF $DATA(^PSDRUG(DRGIEN,"CLOZ2",$ORDER(^PSDRUG(DRGIEN,"CLOZ2",0)),0))
Begin DoDot:2
+12 DO REFILL^PSODIR1(.PSORXED)
IF $GET(PSORXED("DFLG"))
KILL PSORXED("FLD",9)
QUIT
+13 SET PSORXED("FLD",9)=PSORXED("# OF REFILLS")
End DoDot:2
End DoDot:1
QUIT
+14 IF FLN=10
Begin DoDot:1
+15 DO QTY^PSODIR1(.PSORXED)
IF $GET(PSORXED("DFLG"))
KILL PSORXED("FLD",7)
QUIT
+16 if $GET(PSORXED("QTY"))
SET PSORXED("FLD",7)=PSORXED("QTY")
End DoDot:1
QUIT
+17 IF FLN=11
Begin DoDot:1
+18 SET X=$GET(PSORXED("PATIENT STATUS"))
if 'X
SET X=$PIECE(RX0,"^",3)
+19 SET DIC=53
SET DIC(0)="QXZ"
DO ^DIC
KILL DIC
+20 if +Y
SET PSORXED("PTST NODE")=Y(0)
+21 if '$GET(PSORXED("PATIENT STATUS"))
SET PSORXED("PATIENT STATUS")=+Y
+22 KILL X,Y
+23 IF $GET(PSODRUG("IEN"))=$PIECE(RX0,"^",6)
KILL PSODRUG
SET X="`"_$PIECE(RX0,"^",6)
SET DIC=50
SET DIC(0)="QXZ"
DO ^DIC
KILL PSOY
SET PSOY=Y
SET PSOY(0)=Y(0)
DO SET^PSODRG
+24 if '$GET(PSORXED("DAYS SUPPLY"))
SET PSORXED("DAYS SUPPLY")=$PIECE(RX0,"^",8)
+25 FOR I=0:0
SET I=$ORDER(^PSRX(PSORXED("IRXN"),1,I))
if 'I
QUIT
SET RFTT=$GET(RFTT)+1
+26 DO REFILL^PSODIR1(.PSORXED)
KILL RFTT
+27 IF $GET(PSORXED("DFLG"))
KILL PSORXED("FLD",9)
QUIT
+28 IF PSORXED("# OF REFILLS")=$PIECE(RX0,"^",9)
QUIT
+29 SET PSORXED("FLD",9)=PSORXED("# OF REFILLS")
End DoDot:1
QUIT
+30 QUIT
VER ;checks for changes to dosing instructions
+1 SET ENTS=0
+2 FOR I=0:0
SET I=$ORDER(PSORXED("DOSE",I))
if 'I
QUIT
SET ENTS=$GET(ENTS)+1
+3 IF ENTS<OLENT!(ENTS>OLENT)
SET PSOSIGFL=1
QUIT
+4 FOR I=1:1:OLENT
if $DATA(^PSRX(PSORXED("IRXN"),6,I,0))
Begin DoDot:1
+5 IF $PIECE(^PSRX(PSORXED("IRXN"),6,I,0),"^")'=PSORXED("DOSE",I)
SET PSOSIGFL=1
+6 IF $PIECE(^PSRX(PSORXED("IRXN"),6,I,0),"^")=PSORXED("DOSE",I)
Begin DoDot:2
+7 IF $GET(PSORXED("DOSE ORDERED",I))
if PSORXED("DOSE ORDERED",I)'=$PIECE(^PSRX(PSORXED("IRXN"),6,I,0),"^",2)
SET PSOSIGFL=1
End DoDot:2
+8 IF $GET(PSORXED("DURATION",I))]""
Begin DoDot:2
+9 SET DURATION=$SELECT($EXTRACT($PIECE(^PSRX(PSORXED("IRXN"),6,I,0),"^",5),1)'?.N:$EXTRACT($PIECE(^PSRX(PSORXED("IRXN"),6,I,0),"^",5),2,99)_$EXTRACT($PIECE(^PSRX(PSORXED("IRXN"),6,I,0),"^",5),1),1:$PIECE(^PSRX(PSORXED("IRXN"),
6,I,0),"^",5))
+10 IF +DURATION'=+$GET(PSORXED("DURATION",I))
SET PSOSIGFL=1
End DoDot:2
+11 IF $PIECE(^PSRX(PSORXED("IRXN"),6,I,0),"^",6)'=$GET(PSORXED("CONJUNCTION",I))
SET PSOSIGFL=1
+12 IF $PIECE(^PSRX(PSORXED("IRXN"),6,I,0),"^",7)'=$GET(PSORXED("ROUTE",I))
SET PSOSIGFL=1
+13 IF $PIECE(^PSRX(PSORXED("IRXN"),6,I,0),"^",8)'=PSORXED("SCHEDULE",I)
SET PSOSIGFL=1
+14 IF $GET(^PSRX(PSORXED("IRXN"),6,I,1))'=$GET(PSORXED("ODOSE",I))
SET PSOSIGFL=1
End DoDot:1
+15 KILL DURATION
+16 QUIT
+17 ;
RESUB ; Resubmits 3rd party claim in case of an edit (Original)
+1 NEW CHANGED
SET CHANGED=$$CHANGED(PSORXED("IRXN"),.FLDS)
+2 IF CHANGED
Begin DoDot:1
+3 NEW RX
SET RX=PSORXED("IRXN")
if 'RX
QUIT
+4 IF $PIECE(CHANGED,"^",2)
IF '$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,0))
Begin DoDot:2
+5 DO REVERSE^PSOBPSU1(RX,0,"DC",99,"RX DIVISION CHANGED",1)
End DoDot:2
QUIT
+6 IF $$SUBMIT^PSOBPSUT(RX,0,1,1)
Begin DoDot:2
+7 IF '$PIECE(CHANGED,"^",2)
IF $$STATUS^PSOBPSUT(RX,0)=""
QUIT
+8 DO ECMESND^PSOBPSU1(RX,0,,"ED",$$GETNDC^PSONDCUT(RX,0),,$SELECT($PIECE(CHANGED,"^",2):"RX DIVISION CHANGED",1:"RX EDITED"),,+$GET(CHGNDC))
+9 ; Quit if there is an unresolved TRICARE/CHAMPVA non-billable reject code, PSO*7*358
+10 IF $$PSOET^PSOREJP3(RX,0)
SET X="Q"
QUIT
+11 ;- Checking/Handling DUR/79 Rejects
+12 IF $$FIND^PSOREJUT(RX,0)
SET X=$$HDLG^PSOREJU1(RX,0,"79,88,943","ED","IOQ","Q")
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
CHANGED(RX,PRIOR) ; - Check if fields have changed and should for 3rd Party Claim resubmission
+1 ;Input: (r) RX - Rx IEN
+2 ; (r) PRIOR - Array with fields
+3 ;Output: CHANGED - 0 - Not changed / 1 - Original Rx field changed ^ Rx Division changed (1 - YES)
+4 NEW CHANGED,SAVED
+5 SET CHANGED=0
DO GETS^DIQ(52,RX_",","4;7;8;20;22;27;81","I","SAVED")
+6 FOR I=4,7,8,22,27,81
Begin DoDot:1
+7 IF $GET(PRIOR(52,RX_",",I,"I"))'=$GET(SAVED(52,RX_",",I,"I"))
SET CHANGED=1
QUIT
End DoDot:1
IF CHANGED
QUIT
+8 IF $$DIVNCPDP^BPSBUTL(+$GET(PRIOR(52,RX_",",20,"I")))'=$$DIVNCPDP^BPSBUTL(+$GET(SAVED(52,RX_",",20,"I")))
SET CHANGED="1^1"
+9 QUIT CHANGED
+10 ;;
NDCDAWDE(ST,FLN,RXN) ; allow edit of NDC & DAW for DC'd/expired ECME RXs
+1 ;; input: (r) ST - the Rx status code
+2 ;; (r) FLN - field number selected for editing
+3 ;; (r) RXN - prescription #
+4 ;; output: VALMSG for inappropriate field selection or use
+5 ;; PSODRUG & RSORXED arrays updated if edited
+6 if $GET(ST)=""!($GET(FLN)="")!($GET(RXN)="")
QUIT
+7 IF '((ST=11)!(ST=12)!(ST=14)!(ST=15))
SET VALMSG=("Invalid selection!")
QUIT
+8 IF '((FLN=2)!(FLN=20)!(FLN=21))
SET VALMSG=("Invalid selection!")
QUIT
+9 IF $$STATUS^PSOBPSUT(RXN,$$LSTRFL^PSOBPSU1(RXN))=""
SET VALMSG=("Invalid selection!")
QUIT
+10 ;
+11 ; edit NDCs
+12 IF FLN=2
Begin DoDot:1
+13 NEW NDC
+14 SET NDC=$$GETNDC^PSONDCUT(RXN,0)
+15 DO NDCEDT^PSONDCUT(RXN,"",$GET(DRG),$GET(PSOSITE),.NDC)
+16 IF $GET(NDC)="^"
QUIT
+17 SET (PSODRUG("NDC"),PSORXED("FLD",27))=NDC
End DoDot:1
QUIT
+18 ;;
+19 ; edit refill NDCs/DAWs
+20 IF FLN=20
Begin DoDot:1
+21 IF $$LSTRFL^PSOBPSU1(RXN)=0
SET VALMSG="Invalid selection!"
QUIT
+22 DO REF^PSOORED2
End DoDot:1
QUIT
+23 ;;
+24 ; edit DAW
+25 IF FLN=21
Begin DoDot:1
+26 NEW DAW
+27 DO EDTDAW^PSODAWUT(RXN,0,.DAW)
+28 IF $GET(DAW)="^"
QUIT
+29 SET (PSODRUG("DAW"),PSORXED("FLD",81))=DAW
End DoDot:1
QUIT
+30 QUIT
+31 ;;
