PXRMXSL1 ; SLC/PJH - Process Visits/Appts Reminder Due report;06/03/2009
;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
;
; Called from PXRMXSE
;
TMP(DFN,NAM,FACILITY,INP) ;Update ^TMP("PXRMX"
N LOC
I PXRMFCMB="Y" S FACILITY="COMBINED FACILITIES"
I PXRMLCMB="Y" S NAM="COMBINED LOCATIONS"
I PXRMCCS="I" S NAM="Clinic Stop "_NAM_" location "_$P(^SC(INP,0),U)
S LOC=$S(PXRMCCS="B":$P(^SC(INP,0),U),1:"LOC")
S ^TMP("PXRMX",$J,FACILITY,NAM,LOC,DFN)=INP
Q
;
;Mark location as found
MARK(IC) ;
S ^XTMP(PXRMXTMP,"MARKED AS FOUND",IC)=""
Q
;
;Check if facility is on list, PXMRFACN.
HFAC(HLOCIEN) ;
N DIV,HFAC
;DBIA #2804
S HFAC=$P(^SC(HLOCIEN,0),U,4)
I HFAC="" S DIV=$P($G(^SC(HLOCIEN,0)),U,15) S:DIV'="" HFAC=$P($G(^DG(40.8,DIV,0)),U,7)
I HFAC="" S HFAC=+$P($$SITE^VASITE,U,3)
I HFAC="" Q ""
I '$D(PXRMFACN(HFAC)) Q ""
Q HFAC
;
INACTCL(HLIEN,PXRMBDT) ;
;Check to see if clinic is inactivated before the start of
;the reporting period
N INACT,REACT
S INACT=+$P($G(^SC(HLIEN,"I")),U) I INACT=0 Q 0
S REACT=+$P($G(^SC(HLIEN,"I")),U,2)
I REACT'<INACT Q 0
I INACT<PXRMBDT Q 1
Q 0
;
INPADM ;
;Build list of inpatients admissions and current patients on a ward
N BD,DFN,ED,FACILITY,HIEN,NAM
S NAM="All Locations"
S HIEN=0
F S HIEN=$O(^XTMP(PXRMXTMP,"HLOC",HIEN)) Q:HIEN'>0 D
.S FACILITY=$P(^XTMP(PXRMXTMP,"HLOC",HIEN),U,1)
.;Get WARDIEN,WARDNAM and return DFN's in PATS
.N PATS
.I PXRMFD="C" D WARD^PXRMXAP(HIEN,.PATS)
.I PXRMFD="A" D
..; Get admissions from patient movements and return DFN's in PATS
..S BD=PXRMBDT-.0001
..S ED=PXRMEDT+.2359
..D ADM^PXRMXAP(HIEN,.PATS,BD,ED)
.;Split report by location
.I PXRMLCMB="N" S NAM=$P(^XTMP(PXRMXTMP,"HLOC",HIEN),U,2)
.;Build ^TMP for selected patients
.S DFN=""
.F S DFN=$O(PATS(DFN)) Q:DFN="" D
..S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
..D TMP(DFN,NAM,FACILITY,HIEN) D MARK(HIEN)
Q
;
BHLOC ;
N CLINIEN,CGRPIEN,END,FACILITY,NAM,HLIEN,I,START,TEXT
N INACT,REACT
;Initialize the busy counter.
S BUSY=0
;All inpatient, outpatient all location credit stop and encounter
S START=$H
I $P(PXRMLCSC,U)["HA"!($P(PXRMLCSC,U)="CA") D
.S HLIEN=0 F S HLIEN=$O(^SC(HLIEN)) Q:HLIEN'>0 D
..S FACILITY=$$HFAC(HLIEN) I FACILITY'>0 Q
..I $$INACTCL(HLIEN,PXRMBDT)=1 Q
..S NAM=$P(^SC(HLIEN,0),U)
..D NOTIFY^PXRMXBSY("Building hospital locations list",.BUSY)
..;All inpatient locations
..I $P(PXRMLCSC,U)="HAI",$D(^SC(HLIEN,42)) S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM Q
..;All outpatient locations
..I $P(PXRMLCSC,U)="HA",'$D(^SC(HLIEN,42)) S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM Q
..;All encounters with a credit stop
..I $P(PXRMLCSC,U)="CA",$P($G(^SC(HLIEN,0)),U,7)>0 S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM Q
;Selected hosiptal locations
I $P(PXRMLCSC,U,1)="HS" D
.S HLIEN=0 F S HLIEN=$O(PXRMLOCN(HLIEN)) Q:HLIEN'>0 D
..S FACILITY=$$HFAC(HLIEN) I FACILITY'>0 Q
..I $$INACTCL(HLIEN,PXRMBDT)=1 Q
..S NAM=$P(^SC(HLIEN,0),U)
..D NOTIFY^PXRMXBSY("Building hospital locations list",.BUSY)
..S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM
;Selected Credit Stops
I PXRMSEL="L",$P(PXRMLCSC,U)="CS" D
.S CLINIEN=0 F S CLINIEN=$O(PXRMCSN(CLINIEN)) Q:CLINIEN'>0 D
..S HLIEN=0 F S HLIEN=$O(^SC("AST",CLINIEN,HLIEN)) Q:HLIEN'>0 D
...S FACILITY=$$HFAC(HLIEN) I FACILITY'>0 Q
...I $$INACTCL(HLIEN,PXRMBDT)=1 Q
...S NAM=$P(^DIC(40.7,CLINIEN,0),U)_" "_$P(PXRMCS($G(PXRMCSN(CLINIEN))),U,3)
...D NOTIFY^PXRMXBSY("Building hospital locations list",.BUSY)
...S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM_U_$P(PXRMCS($G(PXRMCSN(CLINIEN))),U,3)
;Selected Clinic Groups
I PXRMSEL="L",$E(PXRMLCSC)="G" D
.S CGRPIEN=0 F S CGRPIEN=$O(PXRMCGRN(CGRPIEN)) Q:CGRPIEN'>0 D
..S HLIEN=0 F S HLIEN=$O(^SC("ASCRPW",CGRPIEN,HLIEN)) Q:HLIEN'>0 D
...S FACILITY=$$HFAC(HLIEN) I FACILITY'>0 Q
...I $$INACTCL(HLIEN,PXRMBDT)=1 Q
...D NOTIFY^PXRMXBSY("Building hospital locations list",.BUSY)
...S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_$P(^SC(HLIEN,0),U)_U_CGRPIEN
S END=$H
S TEXT="Elapsed time for building hospital locations list: "_$$DETIME^PXRMXSL1(START,END)
S ^XTMP(PXRMXTMP,"TIMING","BUILDING HOSPITAL LOCATIONS")=TEXT
I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
Q
;
DETIME(START,END) ;
N ETIME,TEXT
S ETIME=$$HDIFF^XLFDT(END,START,2)
I ETIME>90 D
. S ETIME=$$HDIFF^XLFDT(END,START,3)
. S TEXT=ETIME
E S TEXT=ETIME_" secs"
Q TEXT
;
OERR ;
N CNT,II,NAM,OTM
;Initialize the busy counter.
S BUSY=0
S II=""
;Get patient list for each team
F S II=$O(PXRMOTM(II)) Q:II="" D
.S OTM=$P(PXRMOTM(II),U),NAM=$P(PXRMOTM(II),U,2)
.;Build list of patients for OE/RR team ; DBIA #2692
.K ^TMP($J,"OTM")
.D TEAMPTS^ORQPTQ1("^TMP($J,""OTM"",",OTM,1)
.I $G(^TMP($J,"OTM",1))["No patients found" Q
.I PXRMTCMB="Y" N OTM,NAM S OTM="COMBINED",NAM="COMBINED TEAMS"
.S CNT=0 F S CNT=$O(^TMP($J,"OTM",CNT)) Q:CNT'>0 D
..D NOTIFY^PXRMXBSY("Collecting patients from OE/RR List",.BUSY)
..S DFN=$P(^TMP($J,"OTM",CNT),U)
..D UPD1(DFN,NAM,"FACILITY",II)
.D MARK(OTM)
K ^TMP($J,"OTM")
I PXRMREP="D",$D(^TMP($J,"PXRM PATIENT EVAL"))>0 D SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
Q
;
;PCMM provider selected
PCMMP ;
N CNT,DCLN,SCDT,LIST,SCERR,SCLIST,II,PCM,NAM,PNAM,PXRM,OK
N FACILITY,NAM
;Initialize the busy counter.
S BUSY=0
S SCDT("BEGIN")=PXRMSDT,SCDT("END")=PXRMSDT
;Include patient if in team on any day in range
S SCDT("INCL")=0
S II=""
;Get patient list for each PROVIDER
F S II=$O(PXRMPRV(II)) Q:II="" D
.S PCM=$P(PXRMPRV(II),U),NAM=$P(PXRMPRV(II),U,2)
.;Get patients for practs. roles - excluding assoc clinics
.K ^TMP($J,"PCM")
.N SCTEAM D PTPR^PXRMXAP(PCM,PXRMREP)
.I $O(^TMP($J,"PCM",0))="" Q
.;Save in ^TMP in alpha order within team number (internal)
.S CNT=0 F S CNT=$O(^TMP($J,"PCM",CNT)) Q:CNT'>0 D
..S DFN=$P(^TMP($J,"PCM",CNT),U)
..D NOTIFY^PXRMXBSY("Collecting patients from Primary Provider List",.BUSY)
..I PXRMPRIM="P",($$PCASSIGN^PXRMXAP(DFN)'=1) Q
..;For detailed provider report get assoc clinic report future
..;appointment for all location
..I PXRMREP="D" S DCLN=$P(^TMP($J,"PCM",CNT),U,7)
..I $G(DCLN)'="" S PXRMDCLN(DCLN)=""
..D UPD1(DFN,NAM,"FACILITY",+$G(DCLN))
.D MARK(PCM)
K ^TMP($J,"PCM")
I PXRMREP="D",$D(^TMP($J,"PXRM PATIENT EVAL"))>0 D SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
Q
;
;PCMM team selected
PCMMT ;
N CNT,SCDT,LIST,SCERR,SCLIST,II,PCM,NAM,PNAM,OK
;Initialize the busy counter.
S BUSY=0
S SCDT("BEGIN")=PXRMSDT,SCDT("END")=PXRMSDT
;Include patient if in team on any day in range
S SCDT("INCL")=0
S II=""
;Get patient list for each team
F S II=$O(PXRMPCM(II)) Q:II="" D
.S PCM=$P(PXRMPCM(II),U),NAM=$P(PXRMPCM(II),U,2)
.K ^TMP($J,"PCM")
.S OK=$$PTTM^PXRMXAP(PCM,.SCERR) Q:'OK
.I $O(^TMP($J,"PCM",0))="" Q
.S FACILITY=$$FAC^PXRMXAP(PCM)
.S CNT=0 F S CNT=$O(^TMP($J,"PCM",CNT)) Q:CNT'>0 D
..S DFN=$P(^TMP($J,"PCM",CNT),U)
..D NOTIFY^PXRMXBSY("Collecting patients from PCMM Team List",.BUSY)
..D UPD1(DFN,NAM,FACILITY,II)
.D MARK(PCM)
K ^TMP($J,"PCM")
I PXRMREP="D",$D(^TMP($J,"PXRM PATIENT EVAL"))>0 D SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
Q
;
;Individual Patients selected
IND ;
N CNT,DFN,DUMMY,LIST,NAM
S (DUMMY,NAM)="PATIENT"
S CNT=0 F S CNT=$O(PXRMPAT(CNT)) Q:CNT'>0 D
.S DFN=$P(PXRMPAT(CNT),U)
.D UPD1(DFN,"INDIVIDUAL PATIENTS","FACILITY",DFN)
I PXRMREP="D",$D(^TMP($J,"PXRM PATIENT EVAL"))>0 D SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
Q
;
;Patient lists selected
LIST ;
N DFN,DSUB,DUMMY,LCNT,LIEN,LIST,NAM
;Initialize the busy counter.
S BUSY=0
S (DUMMY,NAM)="PATIENT",LCNT=0
F S LCNT=$O(PXRMLIST(LCNT)) Q:'LCNT D
.S LIEN=$P(PXRMLIST(LCNT),U) Q:'LIEN
.S NAM=$P(^PXRMXP(810.5,LIEN,0),U)
.S DSUB=0
.F S DSUB=$O(^PXRMXP(810.5,LIEN,30,DSUB)) Q:'DSUB D
..S DFN=$P($G(^PXRMXP(810.5,LIEN,30,DSUB,0)),U) Q:'DFN
..D NOTIFY^PXRMXBSY("Collecting patients from Reminder Patient List",.BUSY)
..D UPD1(DFN,NAM,"FACILITY",LIEN)
I PXRMREP="D",$D(^TMP($J,"PXRM PATIENT EVAL"))>0 D SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
Q
;
UPD1(DFN,NAM,FACILITY,INP) ;
;Remove test patients.
I 'PXRMTPAT,$$TESTPAT^VADPT(DFN)=1 Q
;Remove patients that are deceased.
I 'PXRMDPAT,$P($G(^DPT(DFN,.35)),U,1)>0 Q
S ^TMP($J,"PXRM PATIENT LIST",DFN)=""
S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
D TMP(DFN,NAM,FACILITY,INP)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXSL1 8551 printed Apr 09, 2024@20:52:17 Page 2
PXRMXSL1 ; SLC/PJH - Process Visits/Appts Reminder Due report;06/03/2009
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
+2 ;
+3 ; Called from PXRMXSE
+4 ;
TMP(DFN,NAM,FACILITY,INP) ;Update ^TMP("PXRMX"
+1 NEW LOC
+2 IF PXRMFCMB="Y"
SET FACILITY="COMBINED FACILITIES"
+3 IF PXRMLCMB="Y"
SET NAM="COMBINED LOCATIONS"
+4 IF PXRMCCS="I"
SET NAM="Clinic Stop "_NAM_" location "_$PIECE(^SC(INP,0),U)
+5 SET LOC=$SELECT(PXRMCCS="B":$PIECE(^SC(INP,0),U),1:"LOC")
+6 SET ^TMP("PXRMX",$JOB,FACILITY,NAM,LOC,DFN)=INP
+7 QUIT
+8 ;
+9 ;Mark location as found
MARK(IC) ;
+1 SET ^XTMP(PXRMXTMP,"MARKED AS FOUND",IC)=""
+2 QUIT
+3 ;
+4 ;Check if facility is on list, PXMRFACN.
HFAC(HLOCIEN) ;
+1 NEW DIV,HFAC
+2 ;DBIA #2804
+3 SET HFAC=$PIECE(^SC(HLOCIEN,0),U,4)
+4 IF HFAC=""
SET DIV=$PIECE($GET(^SC(HLOCIEN,0)),U,15)
if DIV'=""
SET HFAC=$PIECE($GET(^DG(40.8,DIV,0)),U,7)
+5 IF HFAC=""
SET HFAC=+$PIECE($$SITE^VASITE,U,3)
+6 IF HFAC=""
QUIT ""
+7 IF '$DATA(PXRMFACN(HFAC))
QUIT ""
+8 QUIT HFAC
+9 ;
INACTCL(HLIEN,PXRMBDT) ;
+1 ;Check to see if clinic is inactivated before the start of
+2 ;the reporting period
+3 NEW INACT,REACT
+4 SET INACT=+$PIECE($GET(^SC(HLIEN,"I")),U)
IF INACT=0
QUIT 0
+5 SET REACT=+$PIECE($GET(^SC(HLIEN,"I")),U,2)
+6 IF REACT'<INACT
QUIT 0
+7 IF INACT<PXRMBDT
QUIT 1
+8 QUIT 0
+9 ;
INPADM ;
+1 ;Build list of inpatients admissions and current patients on a ward
+2 NEW BD,DFN,ED,FACILITY,HIEN,NAM
+3 SET NAM="All Locations"
+4 SET HIEN=0
+5 FOR
SET HIEN=$ORDER(^XTMP(PXRMXTMP,"HLOC",HIEN))
if HIEN'>0
QUIT
Begin DoDot:1
+6 SET FACILITY=$PIECE(^XTMP(PXRMXTMP,"HLOC",HIEN),U,1)
+7 ;Get WARDIEN,WARDNAM and return DFN's in PATS
+8 NEW PATS
+9 IF PXRMFD="C"
DO WARD^PXRMXAP(HIEN,.PATS)
+10 IF PXRMFD="A"
Begin DoDot:2
+11 ; Get admissions from patient movements and return DFN's in PATS
+12 SET BD=PXRMBDT-.0001
+13 SET ED=PXRMEDT+.2359
+14 DO ADM^PXRMXAP(HIEN,.PATS,BD,ED)
End DoDot:2
+15 ;Split report by location
+16 IF PXRMLCMB="N"
SET NAM=$PIECE(^XTMP(PXRMXTMP,"HLOC",HIEN),U,2)
+17 ;Build ^TMP for selected patients
+18 SET DFN=""
+19 FOR
SET DFN=$ORDER(PATS(DFN))
if DFN=""
QUIT
Begin DoDot:2
+20 SET ^TMP($JOB,"PXRM PATIENT EVAL",DFN)=""
+21 DO TMP(DFN,NAM,FACILITY,HIEN)
DO MARK(HIEN)
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
BHLOC ;
+1 NEW CLINIEN,CGRPIEN,END,FACILITY,NAM,HLIEN,I,START,TEXT
+2 NEW INACT,REACT
+3 ;Initialize the busy counter.
+4 SET BUSY=0
+5 ;All inpatient, outpatient all location credit stop and encounter
+6 SET START=$HOROLOG
+7 IF $PIECE(PXRMLCSC,U)["HA"!($PIECE(PXRMLCSC,U)="CA")
Begin DoDot:1
+8 SET HLIEN=0
FOR
SET HLIEN=$ORDER(^SC(HLIEN))
if HLIEN'>0
QUIT
Begin DoDot:2
+9 SET FACILITY=$$HFAC(HLIEN)
IF FACILITY'>0
QUIT
+10 IF $$INACTCL(HLIEN,PXRMBDT)=1
QUIT
+11 SET NAM=$PIECE(^SC(HLIEN,0),U)
+12 DO NOTIFY^PXRMXBSY("Building hospital locations list",.BUSY)
+13 ;All inpatient locations
+14 IF $PIECE(PXRMLCSC,U)="HAI"
IF $DATA(^SC(HLIEN,42))
SET ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM
QUIT
+15 ;All outpatient locations
+16 IF $PIECE(PXRMLCSC,U)="HA"
IF '$DATA(^SC(HLIEN,42))
SET ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM
QUIT
+17 ;All encounters with a credit stop
+18 IF $PIECE(PXRMLCSC,U)="CA"
IF $PIECE($GET(^SC(HLIEN,0)),U,7)>0
SET ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM
QUIT
End DoDot:2
End DoDot:1
+19 ;Selected hosiptal locations
+20 IF $PIECE(PXRMLCSC,U,1)="HS"
Begin DoDot:1
+21 SET HLIEN=0
FOR
SET HLIEN=$ORDER(PXRMLOCN(HLIEN))
if HLIEN'>0
QUIT
Begin DoDot:2
+22 SET FACILITY=$$HFAC(HLIEN)
IF FACILITY'>0
QUIT
+23 IF $$INACTCL(HLIEN,PXRMBDT)=1
QUIT
+24 SET NAM=$PIECE(^SC(HLIEN,0),U)
+25 DO NOTIFY^PXRMXBSY("Building hospital locations list",.BUSY)
+26 SET ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM
End DoDot:2
End DoDot:1
+27 ;Selected Credit Stops
+28 IF PXRMSEL="L"
IF $PIECE(PXRMLCSC,U)="CS"
Begin DoDot:1
+29 SET CLINIEN=0
FOR
SET CLINIEN=$ORDER(PXRMCSN(CLINIEN))
if CLINIEN'>0
QUIT
Begin DoDot:2
+30 SET HLIEN=0
FOR
SET HLIEN=$ORDER(^SC("AST",CLINIEN,HLIEN))
if HLIEN'>0
QUIT
Begin DoDot:3
+31 SET FACILITY=$$HFAC(HLIEN)
IF FACILITY'>0
QUIT
+32 IF $$INACTCL(HLIEN,PXRMBDT)=1
QUIT
+33 SET NAM=$PIECE(^DIC(40.7,CLINIEN,0),U)_" "_$PIECE(PXRMCS($GET(PXRMCSN(CLINIEN))),U,3)
+34 DO NOTIFY^PXRMXBSY("Building hospital locations list",.BUSY)
+35 SET ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM_U_$PIECE(PXRMCS($GET(PXRMCSN(CLINIEN))),U,3)
End DoDot:3
End DoDot:2
End DoDot:1
+36 ;Selected Clinic Groups
+37 IF PXRMSEL="L"
IF $EXTRACT(PXRMLCSC)="G"
Begin DoDot:1
+38 SET CGRPIEN=0
FOR
SET CGRPIEN=$ORDER(PXRMCGRN(CGRPIEN))
if CGRPIEN'>0
QUIT
Begin DoDot:2
+39 SET HLIEN=0
FOR
SET HLIEN=$ORDER(^SC("ASCRPW",CGRPIEN,HLIEN))
if HLIEN'>0
QUIT
Begin DoDot:3
+40 SET FACILITY=$$HFAC(HLIEN)
IF FACILITY'>0
QUIT
+41 IF $$INACTCL(HLIEN,PXRMBDT)=1
QUIT
+42 DO NOTIFY^PXRMXBSY("Building hospital locations list",.BUSY)
+43 SET ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_$PIECE(^SC(HLIEN,0),U)_U_CGRPIEN
End DoDot:3
End DoDot:2
End DoDot:1
+44 SET END=$HOROLOG
+45 SET TEXT="Elapsed time for building hospital locations list: "_$$DETIME^PXRMXSL1(START,END)
+46 SET ^XTMP(PXRMXTMP,"TIMING","BUILDING HOSPITAL LOCATIONS")=TEXT
+47 IF '(PXRMQUE!$DATA(IO("S"))!(PXRMTABS="Y"))
WRITE !,TEXT
+48 QUIT
+49 ;
DETIME(START,END) ;
+1 NEW ETIME,TEXT
+2 SET ETIME=$$HDIFF^XLFDT(END,START,2)
+3 IF ETIME>90
Begin DoDot:1
+4 SET ETIME=$$HDIFF^XLFDT(END,START,3)
+5 SET TEXT=ETIME
End DoDot:1
+6 IF '$TEST
SET TEXT=ETIME_" secs"
+7 QUIT TEXT
+8 ;
OERR ;
+1 NEW CNT,II,NAM,OTM
+2 ;Initialize the busy counter.
+3 SET BUSY=0
+4 SET II=""
+5 ;Get patient list for each team
+6 FOR
SET II=$ORDER(PXRMOTM(II))
if II=""
QUIT
Begin DoDot:1
+7 SET OTM=$PIECE(PXRMOTM(II),U)
SET NAM=$PIECE(PXRMOTM(II),U,2)
+8 ;Build list of patients for OE/RR team ; DBIA #2692
+9 KILL ^TMP($JOB,"OTM")
+10 DO TEAMPTS^ORQPTQ1("^TMP($J,""OTM"",",OTM,1)
+11 IF $GET(^TMP($JOB,"OTM",1))["No patients found"
QUIT
+12 IF PXRMTCMB="Y"
NEW OTM,NAM
SET OTM="COMBINED"
SET NAM="COMBINED TEAMS"
+13 SET CNT=0
FOR
SET CNT=$ORDER(^TMP($JOB,"OTM",CNT))
if CNT'>0
QUIT
Begin DoDot:2
+14 DO NOTIFY^PXRMXBSY("Collecting patients from OE/RR List",.BUSY)
+15 SET DFN=$PIECE(^TMP($JOB,"OTM",CNT),U)
+16 DO UPD1(DFN,NAM,"FACILITY",II)
End DoDot:2
+17 DO MARK(OTM)
End DoDot:1
+18 KILL ^TMP($JOB,"OTM")
+19 IF PXRMREP="D"
IF $DATA(^TMP($JOB,"PXRM PATIENT EVAL"))>0
DO SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
+20 QUIT
+21 ;
+22 ;PCMM provider selected
PCMMP ;
+1 NEW CNT,DCLN,SCDT,LIST,SCERR,SCLIST,II,PCM,NAM,PNAM,PXRM,OK
+2 NEW FACILITY,NAM
+3 ;Initialize the busy counter.
+4 SET BUSY=0
+5 SET SCDT("BEGIN")=PXRMSDT
SET SCDT("END")=PXRMSDT
+6 ;Include patient if in team on any day in range
+7 SET SCDT("INCL")=0
+8 SET II=""
+9 ;Get patient list for each PROVIDER
+10 FOR
SET II=$ORDER(PXRMPRV(II))
if II=""
QUIT
Begin DoDot:1
+11 SET PCM=$PIECE(PXRMPRV(II),U)
SET NAM=$PIECE(PXRMPRV(II),U,2)
+12 ;Get patients for practs. roles - excluding assoc clinics
+13 KILL ^TMP($JOB,"PCM")
+14 NEW SCTEAM
DO PTPR^PXRMXAP(PCM,PXRMREP)
+15 IF $ORDER(^TMP($JOB,"PCM",0))=""
QUIT
+16 ;Save in ^TMP in alpha order within team number (internal)
+17 SET CNT=0
FOR
SET CNT=$ORDER(^TMP($JOB,"PCM",CNT))
if CNT'>0
QUIT
Begin DoDot:2
+18 SET DFN=$PIECE(^TMP($JOB,"PCM",CNT),U)
+19 DO NOTIFY^PXRMXBSY("Collecting patients from Primary Provider List",.BUSY)
+20 IF PXRMPRIM="P"
IF ($$PCASSIGN^PXRMXAP(DFN)'=1)
QUIT
+21 ;For detailed provider report get assoc clinic report future
+22 ;appointment for all location
+23 IF PXRMREP="D"
SET DCLN=$PIECE(^TMP($JOB,"PCM",CNT),U,7)
+24 IF $GET(DCLN)'=""
SET PXRMDCLN(DCLN)=""
+25 DO UPD1(DFN,NAM,"FACILITY",+$GET(DCLN))
End DoDot:2
+26 DO MARK(PCM)
End DoDot:1
+27 KILL ^TMP($JOB,"PCM")
+28 IF PXRMREP="D"
IF $DATA(^TMP($JOB,"PXRM PATIENT EVAL"))>0
DO SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
+29 QUIT
+30 ;
+31 ;PCMM team selected
PCMMT ;
+1 NEW CNT,SCDT,LIST,SCERR,SCLIST,II,PCM,NAM,PNAM,OK
+2 ;Initialize the busy counter.
+3 SET BUSY=0
+4 SET SCDT("BEGIN")=PXRMSDT
SET SCDT("END")=PXRMSDT
+5 ;Include patient if in team on any day in range
+6 SET SCDT("INCL")=0
+7 SET II=""
+8 ;Get patient list for each team
+9 FOR
SET II=$ORDER(PXRMPCM(II))
if II=""
QUIT
Begin DoDot:1
+10 SET PCM=$PIECE(PXRMPCM(II),U)
SET NAM=$PIECE(PXRMPCM(II),U,2)
+11 KILL ^TMP($JOB,"PCM")
+12 SET OK=$$PTTM^PXRMXAP(PCM,.SCERR)
if 'OK
QUIT
+13 IF $ORDER(^TMP($JOB,"PCM",0))=""
QUIT
+14 SET FACILITY=$$FAC^PXRMXAP(PCM)
+15 SET CNT=0
FOR
SET CNT=$ORDER(^TMP($JOB,"PCM",CNT))
if CNT'>0
QUIT
Begin DoDot:2
+16 SET DFN=$PIECE(^TMP($JOB,"PCM",CNT),U)
+17 DO NOTIFY^PXRMXBSY("Collecting patients from PCMM Team List",.BUSY)
+18 DO UPD1(DFN,NAM,FACILITY,II)
End DoDot:2
+19 DO MARK(PCM)
End DoDot:1
+20 KILL ^TMP($JOB,"PCM")
+21 IF PXRMREP="D"
IF $DATA(^TMP($JOB,"PXRM PATIENT EVAL"))>0
DO SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
+22 QUIT
+23 ;
+24 ;Individual Patients selected
IND ;
+1 NEW CNT,DFN,DUMMY,LIST,NAM
+2 SET (DUMMY,NAM)="PATIENT"
+3 SET CNT=0
FOR
SET CNT=$ORDER(PXRMPAT(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+4 SET DFN=$PIECE(PXRMPAT(CNT),U)
+5 DO UPD1(DFN,"INDIVIDUAL PATIENTS","FACILITY",DFN)
End DoDot:1
+6 IF PXRMREP="D"
IF $DATA(^TMP($JOB,"PXRM PATIENT EVAL"))>0
DO SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
+7 QUIT
+8 ;
+9 ;Patient lists selected
LIST ;
+1 NEW DFN,DSUB,DUMMY,LCNT,LIEN,LIST,NAM
+2 ;Initialize the busy counter.
+3 SET BUSY=0
+4 SET (DUMMY,NAM)="PATIENT"
SET LCNT=0
+5 FOR
SET LCNT=$ORDER(PXRMLIST(LCNT))
if 'LCNT
QUIT
Begin DoDot:1
+6 SET LIEN=$PIECE(PXRMLIST(LCNT),U)
if 'LIEN
QUIT
+7 SET NAM=$PIECE(^PXRMXP(810.5,LIEN,0),U)
+8 SET DSUB=0
+9 FOR
SET DSUB=$ORDER(^PXRMXP(810.5,LIEN,30,DSUB))
if 'DSUB
QUIT
Begin DoDot:2
+10 SET DFN=$PIECE($GET(^PXRMXP(810.5,LIEN,30,DSUB,0)),U)
if 'DFN
QUIT
+11 DO NOTIFY^PXRMXBSY("Collecting patients from Reminder Patient List",.BUSY)
+12 DO UPD1(DFN,NAM,"FACILITY",LIEN)
End DoDot:2
End DoDot:1
+13 IF PXRMREP="D"
IF $DATA(^TMP($JOB,"PXRM PATIENT EVAL"))>0
DO SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
+14 QUIT
+15 ;
UPD1(DFN,NAM,FACILITY,INP) ;
+1 ;Remove test patients.
+2 IF 'PXRMTPAT
IF $$TESTPAT^VADPT(DFN)=1
QUIT
+3 ;Remove patients that are deceased.
+4 IF 'PXRMDPAT
IF $PIECE($GET(^DPT(DFN,.35)),U,1)>0
QUIT
+5 SET ^TMP($JOB,"PXRM PATIENT LIST",DFN)=""
+6 SET ^TMP($JOB,"PXRM PATIENT EVAL",DFN)=""
+7 DO TMP(DFN,NAM,FACILITY,INP)
+8 QUIT
+9 ;
