- 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 Jan 18, 2025@03:28:55 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