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

PSOERPC2.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. 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
  1. S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0),RESETLBD=1
  1. ;Review/Clean-up Locks (e.g.,Session crased and ^XTMP global remained)
  1. D REVLOCKS
  1. ;Review/Releases Future Fill Holds
  1. D UHFFS
  1. Q
  1. ;
  1. REVLOCKS ; Review/Clean-up Locks
  1. N ERXPATID,LKTOUT,DIE,DR,DA
  1. S (ERXPATID,LKTOUT)=0 F S ERXPATID=$O(^XTMP("PSOERXLOCK",ERXPATID)) Q:'ERXPATID D
  1. . L +^XTMP("PSOERXLOCK",ERXPATID):LKTOUT I '$T Q
  1. . L -^XTMP("PSOERXLOCK",ERXPATID) K ^XTMP("PSOERXLOCK",ERXPATID)
  1. . S DIE="^PS(52.46,",DR="6///@",DA=ERXPATID D ^DIE
  1. Q
  1. ;
  1. UHFFS ; Un-Hold Future Fills that are Due
  1. N ERX,HFFIEN,INST,MSGDT,HFFDT,UHSTS,DIE,ERX,DA,DR
  1. S HFFIEN=$O(^PS(52.45,"B","HFF",0)) I 'HFFIEN Q
  1. S (INST,ERX)=0,MSGDT=""
  1. F S INST=$O(^PS(52.49,"E",INST)) Q:'INST D
  1. . F S MSGDT=$O(^PS(52.49,"E",INST,HFFIEN,MSGDT)) Q:'MSGDT D
  1. . . F S ERX=$O(^PS(52.49,"E",INST,HFFIEN,MSGDT,ERX)) Q:'ERX D
  1. . . . S HFFDT=$$GET1^DIQ(52.49,ERX,6.7,"I") I HFFDT>DT Q
  1. . . . S UHSTS=$$UHSTS^PSOERXH1(ERX)
  1. . . . D UPDSTAT^PSOERXU1(ERX,UHSTS,"Future Fill Automatically Un-Held",,$$PROXYDUZ^PSOERXUT())
  1. . . . K DIE S DIE="52.49",DA=ERX,DR="6.7///@" D ^DIE K DIE
  1. Q
  1. ;
  1. MATCHLBL(MATCH) ; Match Filter Label
  1. I MATCH=1 Q $S($G(MBMSITE):"PATIENT FAIL",1:"PATIENT NOT MATCHED")
  1. I MATCH=2 Q $S($G(MBMSITE):"PROVIDER FAIL",1:"PROVIDER NOT MATCHED")
  1. I MATCH=3 Q $S($G(MBMSITE):"DRUG FAIL",1:"DRUG NOT MATCHED")
  1. I MATCH=4 Q $S($G(MBMSITE):"BASIC",1:"ALL MATCHED")
  1. Q ""
  1. ;
  1. 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
  1. ; ERXPAT - eRx Patient IEN (Pointer to #52.46)
  1. ;Ouptut: 1 - Patient qualifies for Match Filter | 0 - Patient does not qualify
  1. ;
  1. N MATCHFLT,RECDAT,ERXIEN,CSERX,MTYPE,ERXSTAT,VPATIEN,VPRVIEN,VDRGIEN,FOUNDONE,STATIEN
  1. S FILTER=+$G(FILTER) I FILTER=5!'FILTER Q 1
  1. S FOUNDONE=0,MATCHFLT=0
  1. I FILTER=4 S MATCHFLT=1
  1. S RECDAT=$$FMADD^XLFDT(DT,-PSOLKBKD)
  1. F S RECDAT=$O(^PS(52.49,"PAT2",ERXPAT,RECDAT)) Q:'RECDAT D Q:(FILTER=4&'MATCHFLT) Q:(FILTER'=4&MATCHFLT)
  1. . 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)
  1. . . S CSERX=+$G(^PS(52.49,ERXIEN,95))
  1. . . S MTYPE=$P($G(^PS(52.49,ERXIEN,0)),"^",8)
  1. . . S STATIEN=+$G(^PS(52.49,ERXIEN,1)),ERXSTAT=$P(^PS(52.45,STATIEN,0),"^")
  1. . . ; Exclude eRx's on Hold
  1. . . I $E(ERXSTAT,1)="H" Q
  1. . . I '$$ELIGSTS^PSOERPC1("PC",ERXSTAT,MTYPE) Q
  1. . . ; - CS/Non-CS Filter
  1. . . I $G(PSOCSERX)="Non-CS",CSERX Q
  1. . . I $G(PSOCSERX)="CS",'CSERX Q
  1. . . ; - Match Status Filter
  1. . . S VPATIEN=+$P($G(^PS(52.49,ERXIEN,0)),"^",5) ; Vista Patient
  1. . . S VPRVIEN=+$P($G(^PS(52.49,ERXIEN,2)),"^",3) ; Vista Provider
  1. . . S VDRGIEN=+$P($G(^PS(52.49,ERXIEN,3)),"^",2) ; Vista Drug
  1. . . S FOUNDONE=1
  1. . . I FILTER=1,'VPATIEN S MATCHFLT=1 Q
  1. . . I FILTER=2,'VPRVIEN,'$$MATCHFLT(1,ERXPAT) S MATCHFLT=1 Q
  1. . . I FILTER=3,'VDRGIEN,'$$MATCHFLT(1,ERXPAT),'$$MATCHFLT(2,ERXPAT) S MATCHFLT=1 Q
  1. . . I FILTER=4,'VDRGIEN!'VPATIEN!'VPRVIEN S MATCHFLT=0 Q
  1. I '$G(FOUNDONE) S MATCHFLT=0
  1. ;
  1. Q MATCHFLT
  1. ;
  1. SETLINE ; - Setting Listman line
  1. N ERXPAT,PATIEN,X1,POS,SORTORD,GROUP,CSERX
  1. K ^TMP("PSOERPC0",$J)
  1. I '$D(^TMP("PSOERPCS",$J)) D Q
  1. . F I=1:1:6 S ^TMP("PSOERPC0",$J,I,0)=""
  1. . S ^TMP("PSOERPC0",$J,7,0)=" No patients with actionable prescriptions found."
  1. . S VALMCNT=1
  1. ;
  1. ; - Resetting list to NORMAL video attributes
  1. D RESET^PSOERUT0()
  1. K GRPLN,PTMTCHLN,PRMTCHLN,DRMTCHLN
  1. ;
  1. ; - Building the list (line by line)
  1. S (GROUP,SEQ)="",LINE=0,SORTORD=$S(PSORDER="A":1,1:-1)
  1. F S GROUP=$O(^TMP("PSOERPCS",$J,GROUP)) Q:GROUP="" D
  1. . I GROUP'="ALL" D
  1. . . N LBL,POS,X
  1. . . S LBL=$S(GROUP="NON-CS":"NON-",1:"")_"CONTROLLED SUBSTANCE Rx's"
  1. . . S POS=41-($L(LBL)\2) S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(LBL))=LBL
  1. . . S LINE=LINE+1,^TMP("PSOERPC0",$J,LINE,0)=X,GRPLN(LINE)=LBL
  1. . S ERXPAT="" F S ERXPAT=$O(^TMP("PSOERPCS",$J,GROUP,ERXPAT),SORTORD) Q:ERXPAT="" D
  1. . . S PATIEN=$G(^TMP("PSOERPCS",$J,GROUP,ERXPAT,"PATIEN"))
  1. . . S Z=$G(^TMP("PSOERPCS",$J,GROUP,ERXPAT)),SEQ=SEQ+1
  1. . . S X1=SEQ_$S($P(Z,"^",11):"]",1:".")
  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))
  1. . . 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)
  1. . . 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)
  1. . . S $E(X1,74)=$J(+$P(Z,"^",10),3)
  1. . . S $E(X1,78)=$J($P(Z,"^",5)+$P(Z,"^",6)+$P(Z,"^",7)+$P(Z,"^",8)+$P(Z,"^",9)+$P(Z,"^",10),3)
  1. . . S LINE=LINE+1,^TMP("PSOERPC0",$J,LINE,0)=X1,^TMP("PSOERPC0",$J,SEQ,"PATIEN")=PATIEN
  1. . . I $D(LOCKPATS(PATIEN)) S HIGHLN(LINE)=1
  1. ;
  1. ; - Saving NORMAL video attributes to be reset later
  1. I LINE>$G(LASTLINE) D
  1. . F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
  1. . S LASTLINE=LINE
  1. D VIDEO^PSOERPT1()
  1. S VALMCNT=+$G(LINE)
  1. Q