PSOERPC2 ;BIRM/MFR - All Patients (Patient Centric) eRx Queue - Supporting APIs 2 ;09/28/22
;;7.0;OUTPATIENT PHARMACY;**700,746**;DEC 1997;Build 106
;
INIT ; Initialization for the option (Setting global variables, Reviewing Locks, Holds, etc.)
; MBMSITE indicates whether it's an MbM site or not, RESETLBD indicates whether the Look Back Days should be reset
S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0),RESETLBD=1
;Review/Clean-up Locks (e.g.,Session crased and ^XTMP global remained)
D REVLOCKS
;Review/Releases Future Fill Holds
D UHFFS
Q
;
REVLOCKS ; Review/Clean-up Locks
N ERXPATID,LKTOUT,DIE,DR,DA
S (ERXPATID,LKTOUT)=0 F S ERXPATID=$O(^XTMP("PSOERXLOCK",ERXPATID)) Q:'ERXPATID D
. L +^XTMP("PSOERXLOCK",ERXPATID):LKTOUT I '$T Q
. L -^XTMP("PSOERXLOCK",ERXPATID) K ^XTMP("PSOERXLOCK",ERXPATID)
. S DIE="^PS(52.46,",DR="6///@",DA=ERXPATID D ^DIE
Q
;
UHFFS ; Un-Hold Future Fills that are Due
N ERX,HFFIEN,INST,MSGDT,HFFDT,UHSTS,DIE,ERX,DA,DR
S HFFIEN=$O(^PS(52.45,"B","HFF",0)) I 'HFFIEN Q
S (INST,ERX)=0,MSGDT=""
F S INST=$O(^PS(52.49,"E",INST)) Q:'INST D
. F S MSGDT=$O(^PS(52.49,"E",INST,HFFIEN,MSGDT)) Q:'MSGDT D
. . F S ERX=$O(^PS(52.49,"E",INST,HFFIEN,MSGDT,ERX)) Q:'ERX D
. . . S HFFDT=$$GET1^DIQ(52.49,ERX,6.7,"I") I HFFDT>DT Q
. . . S UHSTS=$$UHSTS^PSOERXH1(ERX)
. . . D UPDSTAT^PSOERXU1(ERX,UHSTS,"Future Fill Automatically Un-Held",,$$PROXYDUZ^PSOERXUT())
. . . K DIE S DIE="52.49",DA=ERX,DR="6.7///@" D ^DIE K DIE
Q
;
MATCHLBL(MATCH) ; Match Filter Label
I MATCH=1 Q $S($G(MBMSITE):"PATIENT FAIL",1:"PATIENT NOT MATCHED")
I MATCH=2 Q $S($G(MBMSITE):"PROVIDER FAIL",1:"PROVIDER NOT MATCHED")
I MATCH=3 Q $S($G(MBMSITE):"DRUG FAIL",1:"DRUG NOT MATCHED")
I MATCH=4 Q $S($G(MBMSITE):"BASIC",1:"ALL MATCHED")
Q ""
;
MATCHFLT(FILTER,ERXPAT) ; Check whether the patient qualifies for Match Filter
; Input: FILTER - Filter Value: 1 - Patient Fail | 2 - Provider Fail | 3 - Drug Fail | 4 - Basic (All matched) | 5 - All
; ERXPAT - eRx Patient IEN (Pointer to #52.46)
;Ouptut: 1 - Patient qualifies for Match Filter | 0 - Patient does not qualify
;
N MATCHFLT,RECDAT,ERXIEN,CSERX,MTYPE,ERXSTAT,VPATIEN,VPRVIEN,VDRGIEN,FOUNDONE,STATIEN
S FILTER=+$G(FILTER) I FILTER=5!'FILTER Q 1
S FOUNDONE=0,MATCHFLT=0
I FILTER=4 S MATCHFLT=1
S RECDAT=$$FMADD^XLFDT(DT,-PSOLKBKD)
F S RECDAT=$O(^PS(52.49,"PAT2",ERXPAT,RECDAT)) Q:'RECDAT D Q:(FILTER=4&'MATCHFLT) Q:(FILTER'=4&MATCHFLT)
. S ERXIEN=0 F S ERXIEN=$O(^PS(52.49,"PAT2",ERXPAT,RECDAT,ERXIEN)) Q:'ERXIEN D Q:(FILTER=4&'MATCHFLT) Q:(FILTER'=4&MATCHFLT)
. . S CSERX=+$G(^PS(52.49,ERXIEN,95))
. . S MTYPE=$P($G(^PS(52.49,ERXIEN,0)),"^",8)
. . S STATIEN=+$G(^PS(52.49,ERXIEN,1)),ERXSTAT=$P(^PS(52.45,STATIEN,0),"^")
. . ; Exclude eRx's on Hold
. . I $E(ERXSTAT,1)="H" Q
. . I '$$ELIGSTS^PSOERPC1("PC",ERXSTAT,MTYPE) Q
. . ; - CS/Non-CS Filter
. . I $G(PSOCSERX)="Non-CS",CSERX Q
. . I $G(PSOCSERX)="CS",'CSERX Q
. . ; - Match Status Filter
. . S VPATIEN=+$P($G(^PS(52.49,ERXIEN,0)),"^",5) ; Vista Patient
. . S VPRVIEN=+$P($G(^PS(52.49,ERXIEN,2)),"^",3) ; Vista Provider
. . S VDRGIEN=+$P($G(^PS(52.49,ERXIEN,3)),"^",2) ; Vista Drug
. . S FOUNDONE=1
. . I FILTER=1,'VPATIEN S MATCHFLT=1 Q
. . I FILTER=2,'VPRVIEN,'$$MATCHFLT(1,ERXPAT) S MATCHFLT=1 Q
. . I FILTER=3,'VDRGIEN,'$$MATCHFLT(1,ERXPAT),'$$MATCHFLT(2,ERXPAT) S MATCHFLT=1 Q
. . I FILTER=4,'VDRGIEN!'VPATIEN!'VPRVIEN S MATCHFLT=0 Q
I '$G(FOUNDONE) S MATCHFLT=0
;
Q MATCHFLT
;
SETLINE ; - Setting Listman line
N ERXPAT,PATIEN,X1,POS,SORTORD,GROUP,CSERX
K ^TMP("PSOERPC0",$J)
I '$D(^TMP("PSOERPCS",$J)) D Q
. F I=1:1:6 S ^TMP("PSOERPC0",$J,I,0)=""
. S ^TMP("PSOERPC0",$J,7,0)=" No patients with actionable prescriptions found."
. S VALMCNT=1
;
; - Resetting list to NORMAL video attributes
D RESET^PSOERUT0()
K GRPLN,PTMTCHLN,PRMTCHLN,DRMTCHLN
;
; - Building the list (line by line)
S (GROUP,SEQ)="",LINE=0,SORTORD=$S(PSORDER="A":1,1:-1)
F S GROUP=$O(^TMP("PSOERPCS",$J,GROUP)) Q:GROUP="" D
. I GROUP'="ALL" D
. . N LBL,POS,X
. . S LBL=$S(GROUP="NON-CS":"NON-",1:"")_"CONTROLLED SUBSTANCE Rx's"
. . S POS=41-($L(LBL)\2) S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(LBL))=LBL
. . S LINE=LINE+1,^TMP("PSOERPC0",$J,LINE,0)=X,GRPLN(LINE)=LBL
. S ERXPAT="" F S ERXPAT=$O(^TMP("PSOERPCS",$J,GROUP,ERXPAT),SORTORD) Q:ERXPAT="" D
. . S PATIEN=$G(^TMP("PSOERPCS",$J,GROUP,ERXPAT,"PATIEN"))
. . S Z=$G(^TMP("PSOERPCS",$J,GROUP,ERXPAT)),SEQ=SEQ+1
. . S X1=SEQ_$S($P(Z,"^",11):"]",1:".")
. . S $E(X1,$S(SEQ>999:6,1:5))=$E($P(Z,"^",1),1,$S(SEQ>999:23,1:24)),$E(X1,30)=$P(Z,"^",2),$E(X1,41)=$$SSN^PSOERUT($P(Z,"^",3))
. . S $E(X1,54)=$J(+$P(Z,"^",4),3),$E(X1,58)=$J(+$P(Z,"^",5),2),$E(X1,61)=$J(+$P(Z,"^",6),2)
. . S $E(X1,64)=$J(+$P(Z,"^",7),2),$E(X1,67)=$J(+$P(Z,"^",8),2),$E(X1,70)=$J(+$P(Z,"^",9),3)
. . S $E(X1,74)=$J(+$P(Z,"^",10),3)
. . S $E(X1,78)=$J($P(Z,"^",5)+$P(Z,"^",6)+$P(Z,"^",7)+$P(Z,"^",8)+$P(Z,"^",9)+$P(Z,"^",10),3)
. . S LINE=LINE+1,^TMP("PSOERPC0",$J,LINE,0)=X1,^TMP("PSOERPC0",$J,SEQ,"PATIEN")=PATIEN
. . I $D(LOCKPATS(PATIEN)) S HIGHLN(LINE)=1
;
; - Saving NORMAL video attributes to be reset later
I LINE>$G(LASTLINE) D
. F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
. S LASTLINE=LINE
D VIDEO^PSOERPT1()
S VALMCNT=+$G(LINE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERPC2 5407 printed Oct 16, 2024@18:28:25 Page 2
PSOERPC2 ;BIRM/MFR - All Patients (Patient Centric) eRx Queue - Supporting APIs 2 ;09/28/22
+1 ;;7.0;OUTPATIENT PHARMACY;**700,746**;DEC 1997;Build 106
+2 ;
INIT ; Initialization for the option (Setting global variables, Reviewing Locks, Holds, etc.)
+1 ; MBMSITE indicates whether it's an MbM site or not, RESETLBD indicates whether the Look Back Days should be reset
+2 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
SET RESETLBD=1
+3 ;Review/Clean-up Locks (e.g.,Session crased and ^XTMP global remained)
+4 DO REVLOCKS
+5 ;Review/Releases Future Fill Holds
+6 DO UHFFS
+7 QUIT
+8 ;
REVLOCKS ; Review/Clean-up Locks
+1 NEW ERXPATID,LKTOUT,DIE,DR,DA
+2 SET (ERXPATID,LKTOUT)=0
FOR
SET ERXPATID=$ORDER(^XTMP("PSOERXLOCK",ERXPATID))
if 'ERXPATID
QUIT
Begin DoDot:1
+3 LOCK +^XTMP("PSOERXLOCK",ERXPATID):LKTOUT
IF '$TEST
QUIT
+4 LOCK -^XTMP("PSOERXLOCK",ERXPATID)
KILL ^XTMP("PSOERXLOCK",ERXPATID)
+5 SET DIE="^PS(52.46,"
SET DR="6///@"
SET DA=ERXPATID
DO ^DIE
End DoDot:1
+6 QUIT
+7 ;
UHFFS ; Un-Hold Future Fills that are Due
+1 NEW ERX,HFFIEN,INST,MSGDT,HFFDT,UHSTS,DIE,ERX,DA,DR
+2 SET HFFIEN=$ORDER(^PS(52.45,"B","HFF",0))
IF 'HFFIEN
QUIT
+3 SET (INST,ERX)=0
SET MSGDT=""
+4 FOR
SET INST=$ORDER(^PS(52.49,"E",INST))
if 'INST
QUIT
Begin DoDot:1
+5 FOR
SET MSGDT=$ORDER(^PS(52.49,"E",INST,HFFIEN,MSGDT))
if 'MSGDT
QUIT
Begin DoDot:2
+6 FOR
SET ERX=$ORDER(^PS(52.49,"E",INST,HFFIEN,MSGDT,ERX))
if 'ERX
QUIT
Begin DoDot:3
+7 SET HFFDT=$$GET1^DIQ(52.49,ERX,6.7,"I")
IF HFFDT>DT
QUIT
+8 SET UHSTS=$$UHSTS^PSOERXH1(ERX)
+9 DO UPDSTAT^PSOERXU1(ERX,UHSTS,"Future Fill Automatically Un-Held",,$$PROXYDUZ^PSOERXUT())
+10 KILL DIE
SET DIE="52.49"
SET DA=ERX
SET DR="6.7///@"
DO ^DIE
KILL DIE
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
MATCHLBL(MATCH) ; Match Filter Label
+1 IF MATCH=1
QUIT $SELECT($GET(MBMSITE):"PATIENT FAIL",1:"PATIENT NOT MATCHED")
+2 IF MATCH=2
QUIT $SELECT($GET(MBMSITE):"PROVIDER FAIL",1:"PROVIDER NOT MATCHED")
+3 IF MATCH=3
QUIT $SELECT($GET(MBMSITE):"DRUG FAIL",1:"DRUG NOT MATCHED")
+4 IF MATCH=4
QUIT $SELECT($GET(MBMSITE):"BASIC",1:"ALL MATCHED")
+5 QUIT ""
+6 ;
MATCHFLT(FILTER,ERXPAT) ; Check whether the patient qualifies for Match Filter
+1 ; Input: FILTER - Filter Value: 1 - Patient Fail | 2 - Provider Fail | 3 - Drug Fail | 4 - Basic (All matched) | 5 - All
+2 ; ERXPAT - eRx Patient IEN (Pointer to #52.46)
+3 ;Ouptut: 1 - Patient qualifies for Match Filter | 0 - Patient does not qualify
+4 ;
+5 NEW MATCHFLT,RECDAT,ERXIEN,CSERX,MTYPE,ERXSTAT,VPATIEN,VPRVIEN,VDRGIEN,FOUNDONE,STATIEN
+6 SET FILTER=+$GET(FILTER)
IF FILTER=5!'FILTER
QUIT 1
+7 SET FOUNDONE=0
SET MATCHFLT=0
+8 IF FILTER=4
SET MATCHFLT=1
+9 SET RECDAT=$$FMADD^XLFDT(DT,-PSOLKBKD)
+10 FOR
SET RECDAT=$ORDER(^PS(52.49,"PAT2",ERXPAT,RECDAT))
if 'RECDAT
QUIT
Begin DoDot:1
+11 SET ERXIEN=0
FOR
SET ERXIEN=$ORDER(^PS(52.49,"PAT2",ERXPAT,RECDAT,ERXIEN))
if 'ERXIEN
QUIT
Begin DoDot:2
+12 SET CSERX=+$GET(^PS(52.49,ERXIEN,95))
+13 SET MTYPE=$PIECE($GET(^PS(52.49,ERXIEN,0)),"^",8)
+14 SET STATIEN=+$GET(^PS(52.49,ERXIEN,1))
SET ERXSTAT=$PIECE(^PS(52.45,STATIEN,0),"^")
+15 ; Exclude eRx's on Hold
+16 IF $EXTRACT(ERXSTAT,1)="H"
QUIT
+17 IF '$$ELIGSTS^PSOERPC1("PC",ERXSTAT,MTYPE)
QUIT
+18 ; - CS/Non-CS Filter
+19 IF $GET(PSOCSERX)="Non-CS"
IF CSERX
QUIT
+20 IF $GET(PSOCSERX)="CS"
IF 'CSERX
QUIT
+21 ; - Match Status Filter
+22 ; Vista Patient
SET VPATIEN=+$PIECE($GET(^PS(52.49,ERXIEN,0)),"^",5)
+23 ; Vista Provider
SET VPRVIEN=+$PIECE($GET(^PS(52.49,ERXIEN,2)),"^",3)
+24 ; Vista Drug
SET VDRGIEN=+$PIECE($GET(^PS(52.49,ERXIEN,3)),"^",2)
+25 SET FOUNDONE=1
+26 IF FILTER=1
IF 'VPATIEN
SET MATCHFLT=1
QUIT
+27 IF FILTER=2
IF 'VPRVIEN
IF '$$MATCHFLT(1,ERXPAT)
SET MATCHFLT=1
QUIT
+28 IF FILTER=3
IF 'VDRGIEN
IF '$$MATCHFLT(1,ERXPAT)
IF '$$MATCHFLT(2,ERXPAT)
SET MATCHFLT=1
QUIT
+29 IF FILTER=4
IF 'VDRGIEN!'VPATIEN!'VPRVIEN
SET MATCHFLT=0
QUIT
End DoDot:2
if (FILTER=4&'MATCHFLT)
QUIT
if (FILTER'=4&MATCHFLT)
QUIT
End DoDot:1
if (FILTER=4&'MATCHFLT)
QUIT
if (FILTER'=4&MATCHFLT)
QUIT
+30 IF '$GET(FOUNDONE)
SET MATCHFLT=0
+31 ;
+32 QUIT MATCHFLT
+33 ;
SETLINE ; - Setting Listman line
+1 NEW ERXPAT,PATIEN,X1,POS,SORTORD,GROUP,CSERX
+2 KILL ^TMP("PSOERPC0",$JOB)
+3 IF '$DATA(^TMP("PSOERPCS",$JOB))
Begin DoDot:1
+4 FOR I=1:1:6
SET ^TMP("PSOERPC0",$JOB,I,0)=""
+5 SET ^TMP("PSOERPC0",$JOB,7,0)=" No patients with actionable prescriptions found."
+6 SET VALMCNT=1
End DoDot:1
QUIT
+7 ;
+8 ; - Resetting list to NORMAL video attributes
+9 DO RESET^PSOERUT0()
+10 KILL GRPLN,PTMTCHLN,PRMTCHLN,DRMTCHLN
+11 ;
+12 ; - Building the list (line by line)
+13 SET (GROUP,SEQ)=""
SET LINE=0
SET SORTORD=$SELECT(PSORDER="A":1,1:-1)
+14 FOR
SET GROUP=$ORDER(^TMP("PSOERPCS",$JOB,GROUP))
if GROUP=""
QUIT
Begin DoDot:1
+15 IF GROUP'="ALL"
Begin DoDot:2
+16 NEW LBL,POS,X
+17 SET LBL=$SELECT(GROUP="NON-CS":"NON-",1:"")_"CONTROLLED SUBSTANCE Rx's"
+18 SET POS=41-($LENGTH(LBL)\2)
SET X=""
SET $PIECE(X," ",81)=""
SET $EXTRACT(X,POS,POS-1+$LENGTH(LBL))=LBL
+19 SET LINE=LINE+1
SET ^TMP("PSOERPC0",$JOB,LINE,0)=X
SET GRPLN(LINE)=LBL
End DoDot:2
+20 SET ERXPAT=""
FOR
SET ERXPAT=$ORDER(^TMP("PSOERPCS",$JOB,GROUP,ERXPAT),SORTORD)
if ERXPAT=""
QUIT
Begin DoDot:2
+21 SET PATIEN=$GET(^TMP("PSOERPCS",$JOB,GROUP,ERXPAT,"PATIEN"))
+22 SET Z=$GET(^TMP("PSOERPCS",$JOB,GROUP,ERXPAT))
SET SEQ=SEQ+1
+23 SET X1=SEQ_$SELECT($PIECE(Z,"^",11):"]",1:".")
+24 SET $EXTRACT(X1,$SELECT(SEQ>999:6,1:5))=$EXTRACT($PIECE(Z,"^",1),1,$SELECT(SEQ>999:23,1:24))
SET $EXTRACT(X1,30)=$PIECE(Z,"^",2)
SET $EXTRACT(X1,41)=$$SSN^PSOERUT($PIECE(Z,"^",3))
+25 SET $EXTRACT(X1,54)=$JUSTIFY(+$PIECE(Z,"^",4),3)
SET $EXTRACT(X1,58)=$JUSTIFY(+$PIECE(Z,"^",5),2)
SET $EXTRACT(X1,61)=$JUSTIFY(+$PIECE(Z,"^",6),2)
+26 SET $EXTRACT(X1,64)=$JUSTIFY(+$PIECE(Z,"^",7),2)
SET $EXTRACT(X1,67)=$JUSTIFY(+$PIECE(Z,"^",8),2)
SET $EXTRACT(X1,70)=$JUSTIFY(+$PIECE(Z,"^",9),3)
+27 SET $EXTRACT(X1,74)=$JUSTIFY(+$PIECE(Z,"^",10),3)
+28 SET $EXTRACT(X1,78)=$JUSTIFY($PIECE(Z,"^",5)+$PIECE(Z,"^",6)+$PIECE(Z,"^",7)+$PIECE(Z,"^",8)+$PIECE(Z,"^",9)+$PIECE(Z,"^",10),3)
+29 SET LINE=LINE+1
SET ^TMP("PSOERPC0",$JOB,LINE,0)=X1
SET ^TMP("PSOERPC0",$JOB,SEQ,"PATIEN")=PATIEN
+30 IF $DATA(LOCKPATS(PATIEN))
SET HIGHLN(LINE)=1
End DoDot:2
End DoDot:1
+31 ;
+32 ; - Saving NORMAL video attributes to be reset later
+33 IF LINE>$GET(LASTLINE)
Begin DoDot:1
+34 FOR I=($GET(LASTLINE)+1):1:LINE
DO SAVE^VALM10(I)
+35 SET LASTLINE=LINE
End DoDot:1
+36 DO VIDEO^PSOERPT1()
+37 SET VALMCNT=+$GET(LINE)
+38 QUIT
