- 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 Feb 18, 2025@23:58:22 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 ;;