PSOERPT2 ;BIRM/MFR - eRx Patient Medication Profile - Cont'd ; 12/10/22 9:50am
;;7.0;OUTPATIENT PHARMACY;**700,746**;DEC 1997;Build 106
;
HOLDELIG(ERXLST) ; Given a list of eRx IENs (array passed in by Reference) it checks if they can all be put on HOLD
N HOLDELIG,SEQ,ERXIEN
S HOLDELIG=1,SEQ=0 F S SEQ=$O(ERXLST(SEQ)) Q:'SEQ D
. S ERXIEN=ERXLST(SEQ)
. I $$GET1^DIQ(52.49,+$G(ERXIEN),10.5,"I")=2 D S HOLDELIG=0 Q
. . S $P(ERXLST(SEQ),"^",2)="DO NOT FILL eRx record"
. S ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1,"E")
. S MSGTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
. I $$GET1^DIQ(52.49,+$G(ERXIEN),10.5,"I")=2 D S HOLDELIG=0 Q
. . S $P(ERXLST(SEQ),"^",2)="DO NOT FILL record"
. I $E(ERXSTAT,1)="H" D S HOLDELIG=0 Q
. . S $P(ERXLST(SEQ),"^",2)="eRx already on Hold"
. I $E(ERXSTAT,1,3)="REM" D S HOLDELIG=0 Q
. . S $P(ERXLST(SEQ),"^",2)="eRx with a status of 'Removed'."
. I $F(" RJ RM PR "," "_ERXSTAT_" ") D S HOLDELIG=0 Q
. . S $P(ERXLST(SEQ),"^",2)="eRx with a status of 'Rejected', 'Removed' or 'Processed'."
. I ERXSTAT="RXP"!(ERXSTAT="RXC")!(ERXSTAT="RXE") D S HOLDELIG=0 Q
. . S $P(ERXLST(SEQ),"^",2)="Response record with a status of 'Complete', 'Processed', or 'Error'."
Q HOLDELIG
;
UNHDELIG(ERXLST) ; Given a list of eRx IENs (array passed in by Reference) it checks if they can all be put on HOLD
N UNHDELIG,SEQ,ERXIEN
S UNHDELIG=1,SEQ=0 F S SEQ=$O(ERXLST(SEQ)) Q:'SEQ D
. S ERXIEN=ERXLST(SEQ)
. I $$GET1^DIQ(52.49,+$G(ERXIEN),10.5,"I")=2 D S UNHDELIG=0 Q
. . S $P(ERXLST(SEQ),"^",2)="DO NOT FILL eRx record"
. S ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1,"E")
. S MSGTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
. I $E(ERXSTAT,1)'="H" D S UNHDELIG=0 Q
. . S $P(ERXLST(SEQ),"^",2)="eRx is not on Hold"
Q UNHDELIG
;
UNHDSTAT(ERXIEN) ; Returns the Status the eRx should be set to after being Un-Held
N MSGTYPE,ERXSTAT,ERXSTATI
S MSGTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
S ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1,"E")
I $$GET1^DIQ(52.49,ERXIEN,1.3,"I"),$$GET1^DIQ(52.49,ERXIEN,1.5,"I"),$$GET1^DIQ(52.49,ERXIEN,1.7,"I") D Q ERXSTAT
. I MSGTYPE="N" S ERXSTATI=$$PRESOLV^PSOERXA1("W","ERX"),ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E") Q
. I MSGTYPE="RE" S ERXSTATI=$$PRESOLV^PSOERXA1("RXW","ERX"),ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E")
. I MSGTYPE="CX" S ERXSTATI=$$PRESOLV^PSOERXA1("CXW","ERX"),ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E")
I MSGTYPE="N" S ERXSTATI=$$PRESOLV^PSOERXA1("I","ERX"),ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E")
I MSGTYPE="RE" S ERXSTATI=$$PRESOLV^PSOERXA1("RXI","ERX"),ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E")
I MSGTYPE="CX" S ERXSTATI=$$PRESOLV^PSOERXA1("CXI","ERX"),ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E")
Q ERXSTAT
;
MATCH(TYPE,ERXIEN) ; Returns the eRx Match for Patient/Provider/Drug
; Input: TYPE - Type of Match (PAM:Patient Match|PRM:Provider Match|DRM:Drug Match)
; ERXIEN - eRx IEN (Pointer to #52.49)
;Output: MATCH - P1: Match info (Ex: "":(Not Matched)|M:Manual matched|AV: Auto matched & Verified)
; P2: 1:Auto Matched & Manual Matched afterwards | 0: Not Edited
; p3: 1:Auto-Validated | 0: Not auto-validated
N MAT,VAL,MORA,AVAL
S MAT=$S(TYPE="PAM":$$GET1^DIQ(52.49,ERXIEN,.05,"I"),TYPE="PRM":$$GET1^DIQ(52.49,ERXIEN,2.3,"I"),1:$$GET1^DIQ(52.49,ERXIEN,3.2,"I"))
S MORA=+$S(TYPE="PAM":$$GET1^DIQ(52.49,ERXIEN,1.6,"I"),TYPE="PRM":$$GET1^DIQ(52.49,ERXIEN,1.2,"I"),1:$$GET1^DIQ(52.49,ERXIEN,1.4,"I"))
S VAL=$S(TYPE="PAM":$$GET1^DIQ(52.49,ERXIEN,1.13,"I"),TYPE="PRM":$$GET1^DIQ(52.49,ERXIEN,1.8,"I"),1:$$GET1^DIQ(52.49,ERXIEN,1.11,"I"))
S AVAL=0 I TYPE="PRM",$$GET1^DIQ(52.49,ERXIEN,1.8,"I")=$$PROXYDUZ^PSOERXUT() S AVAL=1
Q $S('MAT:"",1:$S(MORA=1:"A",1:"M")_$S(VAL:"V",1:""),1:"")_"^"_$S(MORA=2:1,1:0)_"^"_AVAL
;
MATCHSRT(PAT,PRO,DRU) ; Returns the Matching Score for Sorting purpose
I PAT="",PRO="",DRU="" Q 1
I PAT=""&(PRO="") Q 2
I PAT=""&(DRU="") Q 2
I PRO=""&(DRU="") Q 2
I PAT=""!(PRO="")!(DRU="") Q 3
I PAT["V",PRO["V",DRU["V" Q 8
I PAT["V"&(PRO["V") Q 7
I PAT["V"&(DRU["V") Q 7
I PRO["V"&(DRU["V") Q 7
I PAT["V"!(PRO["V")!(DRU["V") Q 6
I PAT="M"&(PRO="M") Q 5
I PAT="M"&(DRU="M") Q 5
I PRO="M"&(DRU="M") Q 5
Q 4
;
HASACTRX(EPATIEN) ; Checks whether the eRx Patient has any Actionable prescription (other than on Hold)
; Input: EPATIEN - Pointer to ERX PATIENT file (#52.46)
;Output: 0: No Actionable eRx found | 1: Actionable eRx's found
N HASACTRX,ERXIEN,RELMSGID,RECDAT,LBDAYS
S LBDAYS=$$GET1^DIQ(59,PSOSITE,10.2) S:'LBDAYS LBDAYS=365
S (ERXIEN,RELMSGID,HASACTRX)=0,RECDAT=$$FMADD^XLFDT(DT,-LBDAYS)
F S RECDAT=$O(^PS(52.49,"PAT2",EPATIEN,RECDAT)) Q:'RECDAT D
. F S ERXIEN=$O(^PS(52.49,"PAT2",EPATIEN,RECDAT,ERXIEN)) Q:'ERXIEN D I HASACTRX Q
. . I ",N,I,W,"[(","_$$GET1^DIQ(52.49,ERXIEN,1)_",") S HASACTRX=1
. . F S RELMSGID=$O(^PS(52.49,ERXIEN,201,"B",RELMSGID)) Q:'RELMSGID D I HASACTRX Q
. . . I ",N,I,W,"[(","_$$GET1^DIQ(52.49,RELMSGID,1)_",") S HASACTRX=1
Q HASACTRX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERPT2 5029 printed Dec 13, 2024@02:27:51 Page 2
PSOERPT2 ;BIRM/MFR - eRx Patient Medication Profile - Cont'd ; 12/10/22 9:50am
+1 ;;7.0;OUTPATIENT PHARMACY;**700,746**;DEC 1997;Build 106
+2 ;
HOLDELIG(ERXLST) ; Given a list of eRx IENs (array passed in by Reference) it checks if they can all be put on HOLD
+1 NEW HOLDELIG,SEQ,ERXIEN
+2 SET HOLDELIG=1
SET SEQ=0
FOR
SET SEQ=$ORDER(ERXLST(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+3 SET ERXIEN=ERXLST(SEQ)
+4 IF $$GET1^DIQ(52.49,+$GET(ERXIEN),10.5,"I")=2
Begin DoDot:2
+5 SET $PIECE(ERXLST(SEQ),"^",2)="DO NOT FILL eRx record"
End DoDot:2
SET HOLDELIG=0
QUIT
+6 SET ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1,"E")
+7 SET MSGTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+8 IF $$GET1^DIQ(52.49,+$GET(ERXIEN),10.5,"I")=2
Begin DoDot:2
+9 SET $PIECE(ERXLST(SEQ),"^",2)="DO NOT FILL record"
End DoDot:2
SET HOLDELIG=0
QUIT
+10 IF $EXTRACT(ERXSTAT,1)="H"
Begin DoDot:2
+11 SET $PIECE(ERXLST(SEQ),"^",2)="eRx already on Hold"
End DoDot:2
SET HOLDELIG=0
QUIT
+12 IF $EXTRACT(ERXSTAT,1,3)="REM"
Begin DoDot:2
+13 SET $PIECE(ERXLST(SEQ),"^",2)="eRx with a status of 'Removed'."
End DoDot:2
SET HOLDELIG=0
QUIT
+14 IF $FIND(" RJ RM PR "," "_ERXSTAT_" ")
Begin DoDot:2
+15 SET $PIECE(ERXLST(SEQ),"^",2)="eRx with a status of 'Rejected', 'Removed' or 'Processed'."
End DoDot:2
SET HOLDELIG=0
QUIT
+16 IF ERXSTAT="RXP"!(ERXSTAT="RXC")!(ERXSTAT="RXE")
Begin DoDot:2
+17 SET $PIECE(ERXLST(SEQ),"^",2)="Response record with a status of 'Complete', 'Processed', or 'Error'."
End DoDot:2
SET HOLDELIG=0
QUIT
End DoDot:1
+18 QUIT HOLDELIG
+19 ;
UNHDELIG(ERXLST) ; Given a list of eRx IENs (array passed in by Reference) it checks if they can all be put on HOLD
+1 NEW UNHDELIG,SEQ,ERXIEN
+2 SET UNHDELIG=1
SET SEQ=0
FOR
SET SEQ=$ORDER(ERXLST(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+3 SET ERXIEN=ERXLST(SEQ)
+4 IF $$GET1^DIQ(52.49,+$GET(ERXIEN),10.5,"I")=2
Begin DoDot:2
+5 SET $PIECE(ERXLST(SEQ),"^",2)="DO NOT FILL eRx record"
End DoDot:2
SET UNHDELIG=0
QUIT
+6 SET ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1,"E")
+7 SET MSGTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+8 IF $EXTRACT(ERXSTAT,1)'="H"
Begin DoDot:2
+9 SET $PIECE(ERXLST(SEQ),"^",2)="eRx is not on Hold"
End DoDot:2
SET UNHDELIG=0
QUIT
End DoDot:1
+10 QUIT UNHDELIG
+11 ;
UNHDSTAT(ERXIEN) ; Returns the Status the eRx should be set to after being Un-Held
+1 NEW MSGTYPE,ERXSTAT,ERXSTATI
+2 SET MSGTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+3 SET ERXSTAT=$$GET1^DIQ(52.49,ERXIEN,1,"E")
+4 IF $$GET1^DIQ(52.49,ERXIEN,1.3,"I")
IF $$GET1^DIQ(52.49,ERXIEN,1.5,"I")
IF $$GET1^DIQ(52.49,ERXIEN,1.7,"I")
Begin DoDot:1
+5 IF MSGTYPE="N"
SET ERXSTATI=$$PRESOLV^PSOERXA1("W","ERX")
SET ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E")
QUIT
+6 IF MSGTYPE="RE"
SET ERXSTATI=$$PRESOLV^PSOERXA1("RXW","ERX")
SET ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E")
+7 IF MSGTYPE="CX"
SET ERXSTATI=$$PRESOLV^PSOERXA1("CXW","ERX")
SET ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E")
End DoDot:1
QUIT ERXSTAT
+8 IF MSGTYPE="N"
SET ERXSTATI=$$PRESOLV^PSOERXA1("I","ERX")
SET ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E")
+9 IF MSGTYPE="RE"
SET ERXSTATI=$$PRESOLV^PSOERXA1("RXI","ERX")
SET ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E")
+10 IF MSGTYPE="CX"
SET ERXSTATI=$$PRESOLV^PSOERXA1("CXI","ERX")
SET ERXSTAT=$$GET1^DIQ(52.45,ERXSTATI,.01,"E")
+11 QUIT ERXSTAT
+12 ;
MATCH(TYPE,ERXIEN) ; Returns the eRx Match for Patient/Provider/Drug
+1 ; Input: TYPE - Type of Match (PAM:Patient Match|PRM:Provider Match|DRM:Drug Match)
+2 ; ERXIEN - eRx IEN (Pointer to #52.49)
+3 ;Output: MATCH - P1: Match info (Ex: "":(Not Matched)|M:Manual matched|AV: Auto matched & Verified)
+4 ; P2: 1:Auto Matched & Manual Matched afterwards | 0: Not Edited
+5 ; p3: 1:Auto-Validated | 0: Not auto-validated
+6 NEW MAT,VAL,MORA,AVAL
+7 SET MAT=$SELECT(TYPE="PAM":$$GET1^DIQ(52.49,ERXIEN,.05,"I"),TYPE="PRM":$$GET1^DIQ(52.49,ERXIEN,2.3,"I"),1:$$GET1^DIQ(52.49,ERXIEN,3.2,"I"))
+8 SET MORA=+$SELECT(TYPE="PAM":$$GET1^DIQ(52.49,ERXIEN,1.6,"I"),TYPE="PRM":$$GET1^DIQ(52.49,ERXIEN,1.2,"I"),1:$$GET1^DIQ(52.49,ERXIEN,1.4,"I"))
+9 SET VAL=$SELECT(TYPE="PAM":$$GET1^DIQ(52.49,ERXIEN,1.13,"I"),TYPE="PRM":$$GET1^DIQ(52.49,ERXIEN,1.8,"I"),1:$$GET1^DIQ(52.49,ERXIEN,1.11,"I"))
+10 SET AVAL=0
IF TYPE="PRM"
IF $$GET1^DIQ(52.49,ERXIEN,1.8,"I")=$$PROXYDUZ^PSOERXUT()
SET AVAL=1
+11 QUIT $SELECT('MAT:"",1:$SELECT(MORA=1:"A",1:"M")_$SELECT(VAL:"V",1:""),1:"")_"^"_$SELECT(MORA=2:1,1:0)_"^"_AVAL
+12 ;
MATCHSRT(PAT,PRO,DRU) ; Returns the Matching Score for Sorting purpose
+1 IF PAT=""
IF PRO=""
IF DRU=""
QUIT 1
+2 IF PAT=""&(PRO="")
QUIT 2
+3 IF PAT=""&(DRU="")
QUIT 2
+4 IF PRO=""&(DRU="")
QUIT 2
+5 IF PAT=""!(PRO="")!(DRU="")
QUIT 3
+6 IF PAT["V"
IF PRO["V"
IF DRU["V"
QUIT 8
+7 IF PAT["V"&(PRO["V")
QUIT 7
+8 IF PAT["V"&(DRU["V")
QUIT 7
+9 IF PRO["V"&(DRU["V")
QUIT 7
+10 IF PAT["V"!(PRO["V")!(DRU["V")
QUIT 6
+11 IF PAT="M"&(PRO="M")
QUIT 5
+12 IF PAT="M"&(DRU="M")
QUIT 5
+13 IF PRO="M"&(DRU="M")
QUIT 5
+14 QUIT 4
+15 ;
HASACTRX(EPATIEN) ; Checks whether the eRx Patient has any Actionable prescription (other than on Hold)
+1 ; Input: EPATIEN - Pointer to ERX PATIENT file (#52.46)
+2 ;Output: 0: No Actionable eRx found | 1: Actionable eRx's found
+3 NEW HASACTRX,ERXIEN,RELMSGID,RECDAT,LBDAYS
+4 SET LBDAYS=$$GET1^DIQ(59,PSOSITE,10.2)
if 'LBDAYS
SET LBDAYS=365
+5 SET (ERXIEN,RELMSGID,HASACTRX)=0
SET RECDAT=$$FMADD^XLFDT(DT,-LBDAYS)
+6 FOR
SET RECDAT=$ORDER(^PS(52.49,"PAT2",EPATIEN,RECDAT))
if 'RECDAT
QUIT
Begin DoDot:1
+7 FOR
SET ERXIEN=$ORDER(^PS(52.49,"PAT2",EPATIEN,RECDAT,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:2
+8 IF ",N,I,W,"[(","_$$GET1^DIQ(52.49,ERXIEN,1)_",")
SET HASACTRX=1
+9 FOR
SET RELMSGID=$ORDER(^PS(52.49,ERXIEN,201,"B",RELMSGID))
if 'RELMSGID
QUIT
Begin DoDot:3
+10 IF ",N,I,W,"[(","_$$GET1^DIQ(52.49,RELMSGID,1)_",")
SET HASACTRX=1
End DoDot:3
IF HASACTRX
QUIT
End DoDot:2
IF HASACTRX
QUIT
End DoDot:1
+11 QUIT HASACTRX
