Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOORED7

PSOORED7.m

Go to the documentation of this file.
  1. 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
  1. ;called from psooredt. cmop edit checks.
  1. ;Reference to file #50 supported by IA 221
  1. ;Reference to $$ECMEON^BPSUTIL supported by IA 4410
  1. ;Reference to $$DIVNCPDP^BPSBUTL supported by IA 4719
  1. ;
  1. 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
  1. 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
  1. K CMRL,DIC,DIQ
  1. S DIC=52,DA=PSORXED("IRXN"),DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ
  1. S PSORXED($S(FLN=9:"DAYS SUPPLY",FLN=10:"QTY",1:"# OF REFILLS"))=PSORXED(52,DA,DR)
  1. D:'$O(PSORXED("DOSE",0)) DOLST^PSOORED3
  1. I FLN=9 D Q
  1. .D DAYS^PSODIR1(.PSORXED) I $G(PSORXED("DFLG")) K PSORXED("FLD",8) Q
  1. .S PSORXED("FLD",8)=PSORXED("DAYS SUPPLY")
  1. .;PSO*7*611 Prompt the user for the Refills # so it will stay in sync with the Days Supply
  1. .;PSO*7*624 Only prompt the user for the Refills # if a Clozapine flagged drug with at least 1 registered lab test
  1. .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
  1. ..D REFILL^PSODIR1(.PSORXED) I $G(PSORXED("DFLG")) K PSORXED("FLD",9) Q
  1. ..S PSORXED("FLD",9)=PSORXED("# OF REFILLS")
  1. I FLN=10 D Q
  1. .D QTY^PSODIR1(.PSORXED) I $G(PSORXED("DFLG")) K PSORXED("FLD",7) Q
  1. .S:$G(PSORXED("QTY")) PSORXED("FLD",7)=PSORXED("QTY")
  1. I FLN=11 D Q
  1. .S X=$G(PSORXED("PATIENT STATUS")) S:'X X=$P(RX0,"^",3)
  1. .S DIC=53,DIC(0)="QXZ" D ^DIC K DIC
  1. .S:+Y PSORXED("PTST NODE")=Y(0)
  1. .S:'$G(PSORXED("PATIENT STATUS")) PSORXED("PATIENT STATUS")=+Y
  1. .K X,Y
  1. .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
  1. .S:'$G(PSORXED("DAYS SUPPLY")) PSORXED("DAYS SUPPLY")=$P(RX0,"^",8)
  1. .F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),1,I)) Q:'I S RFTT=$G(RFTT)+1
  1. .D REFILL^PSODIR1(.PSORXED) K RFTT
  1. .I $G(PSORXED("DFLG")) K PSORXED("FLD",9) Q
  1. .I PSORXED("# OF REFILLS")=$P(RX0,"^",9) Q
  1. .S PSORXED("FLD",9)=PSORXED("# OF REFILLS")
  1. Q
  1. VER ;checks for changes to dosing instructions
  1. S ENTS=0
  1. F I=0:0 S I=$O(PSORXED("DOSE",I)) Q:'I S ENTS=$G(ENTS)+1
  1. I ENTS<OLENT!(ENTS>OLENT) S PSOSIGFL=1 Q
  1. F I=1:1:OLENT D:$D(^PSRX(PSORXED("IRXN"),6,I,0))
  1. .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^")'=PSORXED("DOSE",I) S PSOSIGFL=1
  1. .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^")=PSORXED("DOSE",I) D
  1. ..I $G(PSORXED("DOSE ORDERED",I)) S:PSORXED("DOSE ORDERED",I)'=$P(^PSRX(PSORXED("IRXN"),6,I,0),"^",2) PSOSIGFL=1
  1. .I $G(PSORXED("DURATION",I))]"" D
  1. ..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))
  1. ..I +DURATION'=+$G(PSORXED("DURATION",I)) S PSOSIGFL=1
  1. .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",6)'=$G(PSORXED("CONJUNCTION",I)) S PSOSIGFL=1
  1. .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",7)'=$G(PSORXED("ROUTE",I)) S PSOSIGFL=1
  1. .I $P(^PSRX(PSORXED("IRXN"),6,I,0),"^",8)'=PSORXED("SCHEDULE",I) S PSOSIGFL=1
  1. .I $G(^PSRX(PSORXED("IRXN"),6,I,1))'=$G(PSORXED("ODOSE",I)) S PSOSIGFL=1
  1. K DURATION
  1. Q
  1. ;
  1. RESUB ; Resubmits 3rd party claim in case of an edit (Original)
  1. N CHANGED S CHANGED=$$CHANGED(PSORXED("IRXN"),.FLDS)
  1. I CHANGED D
  1. . N RX S RX=PSORXED("IRXN") Q:'RX
  1. . I $P(CHANGED,"^",2),'$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,0)) D Q
  1. . . D REVERSE^PSOBPSU1(RX,0,"DC",99,"RX DIVISION CHANGED",1)
  1. . I $$SUBMIT^PSOBPSUT(RX,0,1,1) D
  1. . . I '$P(CHANGED,"^",2),$$STATUS^PSOBPSUT(RX,0)="" Q
  1. . . D ECMESND^PSOBPSU1(RX,0,,"ED",$$GETNDC^PSONDCUT(RX,0),,$S($P(CHANGED,"^",2):"RX DIVISION CHANGED",1:"RX EDITED"),,+$G(CHGNDC))
  1. . . ; Quit if there is an unresolved TRICARE/CHAMPVA non-billable reject code, PSO*7*358
  1. . . I $$PSOET^PSOREJP3(RX,0) S X="Q" Q
  1. . . ;- Checking/Handling DUR/79 Rejects
  1. . . I $$FIND^PSOREJUT(RX,0) S X=$$HDLG^PSOREJU1(RX,0,"79,88,943","ED","IOQ","Q")
  1. Q
  1. ;
  1. CHANGED(RX,PRIOR) ; - Check if fields have changed and should for 3rd Party Claim resubmission
  1. ;Input: (r) RX - Rx IEN
  1. ; (r) PRIOR - Array with fields
  1. ;Output: CHANGED - 0 - Not changed / 1 - Original Rx field changed ^ Rx Division changed (1 - YES)
  1. N CHANGED,SAVED
  1. S CHANGED=0 D GETS^DIQ(52,RX_",","4;7;8;20;22;27;81","I","SAVED")
  1. F I=4,7,8,22,27,81 D I CHANGED Q
  1. . I $G(PRIOR(52,RX_",",I,"I"))'=$G(SAVED(52,RX_",",I,"I")) S CHANGED=1 Q
  1. I $$DIVNCPDP^BPSBUTL(+$G(PRIOR(52,RX_",",20,"I")))'=$$DIVNCPDP^BPSBUTL(+$G(SAVED(52,RX_",",20,"I"))) S CHANGED="1^1"
  1. Q CHANGED
  1. ;;
  1. NDCDAWDE(ST,FLN,RXN) ; allow edit of NDC & DAW for DC'd/expired ECME RXs
  1. ;; input: (r) ST - the Rx status code
  1. ;; (r) FLN - field number selected for editing
  1. ;; (r) RXN - prescription #
  1. ;; output: VALMSG for inappropriate field selection or use
  1. ;; PSODRUG & RSORXED arrays updated if edited
  1. Q:$G(ST)=""!($G(FLN)="")!($G(RXN)="")
  1. I '((ST=11)!(ST=12)!(ST=14)!(ST=15)) S VALMSG=("Invalid selection!") Q
  1. I '((FLN=2)!(FLN=20)!(FLN=21)) S VALMSG=("Invalid selection!") Q
  1. I $$STATUS^PSOBPSUT(RXN,$$LSTRFL^PSOBPSU1(RXN))="" S VALMSG=("Invalid selection!") Q
  1. ;
  1. ; edit NDCs
  1. I FLN=2 D Q
  1. .N NDC
  1. .S NDC=$$GETNDC^PSONDCUT(RXN,0)
  1. .D NDCEDT^PSONDCUT(RXN,"",$G(DRG),$G(PSOSITE),.NDC)
  1. .I $G(NDC)="^" Q
  1. .S (PSODRUG("NDC"),PSORXED("FLD",27))=NDC
  1. ;;
  1. ; edit refill NDCs/DAWs
  1. I FLN=20 D Q
  1. .I $$LSTRFL^PSOBPSU1(RXN)=0 S VALMSG="Invalid selection!" Q
  1. .D REF^PSOORED2
  1. ;;
  1. ; edit DAW
  1. I FLN=21 D Q
  1. .N DAW
  1. .D EDTDAW^PSODAWUT(RXN,0,.DAW)
  1. .I $G(DAW)="^" Q
  1. .S (PSODRUG("DAW"),PSORXED("FLD",81))=DAW
  1. Q
  1. ;;