158 lines
5.4 KiB
Mathematica
158 lines
5.4 KiB
Mathematica
SCRPEC2 ;ALB/CMM - Detail List of Pts & Enroll Clinics Continued ; 29 Jun 99 04:11PM
|
|
;;5.3;Scheduling;**41,140,174,177**;AUG 13, 1993
|
|
;
|
|
;Detailed Listing of Patients and Their Enrolled Clinics Report
|
|
;
|
|
PAT(TIEN,PTLIST) ;
|
|
;TIEN - team ien
|
|
;PTLIST - array holding patients assigned to team TIEN
|
|
;
|
|
N PTIEN,ENT,NODE,OKAY,CLLIST,ERR,PC
|
|
S ENT=0,CLLIST="LIST2",ERR="ERROR2"
|
|
K @CLLIST
|
|
F S ENT=$O(@PTLIST@(ENT)) Q:ENT=""!(ENT'?.N) D
|
|
.S NODE=$G(@PTLIST@(ENT))
|
|
.Q:NODE=""
|
|
.S PTIEN=+$P(NODE,"^") ;patient ien
|
|
.S PC=$$PCASSIGN(PTIEN,TIEN)
|
|
.Q:PC'=ASSUN ;not selected assigned/unassigned primary care
|
|
.K @CLLIST
|
|
.S OKAY=$$CLPT^SCAPMC29(PTIEN,"","",.CLLIST,.ERR)
|
|
.;all clinics for patient PTIEN
|
|
.Q:'OKAY
|
|
.D KEEP(TIEN,PTIEN,.CLLIST)
|
|
K @CLLIST
|
|
Q
|
|
;
|
|
KEEP(TIEN,PTIEN,CLLIST) ;keep data for report
|
|
;TIEN - team ien
|
|
;PTIEN - patient ien
|
|
;CLLIST - array holding clinics for patient PTIEN
|
|
;
|
|
N ENT,TNAME,INS,NODE,INAME,PDATA,NODE,CIEN,CNAME,PNAME
|
|
N SCPCPR,SCPCAP,SCI,PCLIST
|
|
S TNAME=$P($G(^SCTM(404.51,TIEN,0)),"^") ;team name
|
|
S INS=+$P($G(^SCTM(404.51,TIEN,0)),"^",7) ;institution ien
|
|
S INAME=$P($G(^DIC(4,INS,0)),"^") ;institution name
|
|
S PNAME=$P($G(^DPT(PTIEN,0)),"^") ;patient name
|
|
K ^TMP("SC",$J,PTIEN)
|
|
S SCI=$$GETALL^SCAPMCA(PTIEN) D
|
|
.;Name of PC Provider
|
|
.S SCPCPR=$P($G(^TMP("SC",$J,PTIEN,"PCPR",1)),U,2)
|
|
.;Name of Associate Provider
|
|
.S SCPCAP=$P($G(^TMP("SC",$J,PTIEN,"PCAP",1)),U,2)
|
|
.Q
|
|
;
|
|
S ENT=0
|
|
F S ENT=$O(@CLLIST@(ENT)) Q:ENT=""!(ENT'?.N) D
|
|
.S NODE=$G(@CLLIST@(ENT))
|
|
.S CIEN=+$P(NODE,"^") ;clinic ien
|
|
.I CLINIC'=1,'$D(CLINIC(CIEN)) Q
|
|
.S CNAME=$P(NODE,"^",2) ;clinic name
|
|
.D SETUP(INS,INAME,TIEN,TNAME,PTIEN,PNAME,CIEN,CNAME)
|
|
.S PDATA=$$PDATA^SCRPEC(PTIEN,CIEN,1)
|
|
.S $P(PDATA,U,9)=SCPCPR,$P(PDATA,U,10)=SCPCAP
|
|
.;name^pid^mt^pelig^pstat^statd^last^next^pc prov.^assoc. prov.
|
|
.D FORMAT(PTIEN,INS,TIEN,PDATA,CNAME,CIEN)
|
|
Q
|
|
;
|
|
SETUP(INS,INAME,TIEN,TNAME,PTIEN,PNAME,CIEN,CNAME) ;
|
|
;INS - institution ien
|
|
;INAME - institution name
|
|
;TIEN - team ien
|
|
;TNAME - team name
|
|
;PTIEN - patient ien
|
|
;PNAME - patient name
|
|
;CIEN - clinic ien
|
|
;CNAME - clinic name
|
|
;
|
|
I INAME="" S INAME="[BAD DATA]"
|
|
I TNAME="" S TNAME="[BAD DATA]"
|
|
I CNAME="" S CNAME="[BAD DATA]"
|
|
I PNAME="" S PNAME="[BAD DATA]"
|
|
I '$D(@STORE@("I",INAME,INS)) S @STORE@("I",INAME,INS)="",@STORE@(INS)="Division: "_INAME
|
|
I '$D(@STORE@("T",INS,TNAME,TIEN)) S @STORE@("T",INS,TNAME,TIEN)="",@STORE@(INS,TIEN)="Team: "_TNAME
|
|
I '$D(@STORE@("C",INS,TIEN,CNAME,CIEN)) S @STORE@("C",INS,TIEN,CNAME,CIEN)="" ;D HEADER(INS,TIEN,CIEN)
|
|
I '$D(@STORE@("PT",INS,TIEN,CIEN,PNAME,PTIEN)) S @STORE@("PT",INS,TIEN,CIEN,PNAME,PTIEN)=""
|
|
Q
|
|
;
|
|
PCASSIGN(DFN,TIEN) ;patient assigned to team as primary care
|
|
;DFN - patient ien
|
|
;TIEN - team ien
|
|
;1 - yes
|
|
;0 - no
|
|
;
|
|
N ADATE,ENTRY,PC
|
|
S PC=0
|
|
I '$D(^SCPT(404.42,"AIDT",DFN,TIEN)) Q PC
|
|
S ADATE=$O(^SCPT(404.42,"AIDT",DFN,TIEN,"")) ; -team assignemtn date
|
|
S ENTRY=$O(^SCPT(404.42,"AIDT",DFN,TIEN,ADATE,"")) ;patient team assignemtn ien
|
|
I $P($G(^SCPT(404.42,+ENTRY,0)),"^",8)=1 S PC=1
|
|
Q PC
|
|
;
|
|
HEADER ;report column titles
|
|
N HLD
|
|
S HLD="H0"
|
|
S $E(@STORE@("SUBHEADER",HLD),25)="M.T."
|
|
S $E(@STORE@("SUBHEADER",HLD),31)="Prim"
|
|
;Removed by patch 174
|
|
;S $E(@STORE@("SUBHEADER",HLD),31)="Pat"
|
|
;S $E(@STORE@("SUBHEADER",HLD),36)="Status"
|
|
S $E(@STORE@("SUBHEADER",HLD),42)="Last"
|
|
S $E(@STORE@("SUBHEADER",HLD),54)="Next"
|
|
S $E(@STORE@("SUBHEADER",HLD),66)="Enrolled"
|
|
S $E(@STORE@("SUBHEADER",HLD),95)="Primary Care"
|
|
S $E(@STORE@("SUBHEADER",HLD),115)="Associate"
|
|
S HLD="H1"
|
|
S @STORE@("SUBHEADER",HLD)="Patient Name"
|
|
S $E(@STORE@("SUBHEADER",HLD),18)="Pt ID"
|
|
S $E(@STORE@("SUBHEADER",HLD),25)="Stat"
|
|
S $E(@STORE@("SUBHEADER",HLD),31)="Elig"
|
|
;Removed by patch 174
|
|
;S $E(@STORE@("SUBHEADER",HLD),31)="Stat"
|
|
;S $E(@STORE@("SUBHEADER",HLD),36)="Date"
|
|
S $E(@STORE@("SUBHEADER",HLD),42)="Appt"
|
|
S $E(@STORE@("SUBHEADER",HLD),54)="Appt"
|
|
S $E(@STORE@("SUBHEADER",HLD),66)="Clinic"
|
|
S $E(@STORE@("SUBHEADER",HLD),95)="Provider"
|
|
S $E(@STORE@("SUBHEADER",HLD),115)="Provider"
|
|
S HLD="H2"
|
|
S $P(@STORE@("SUBHEADER",HLD),"=",133)=""
|
|
Q
|
|
;
|
|
FORMAT(PTIEN,INS,TIEN,PDATA,CNAME,CIEN) ;format data for report
|
|
;PTIEN - patient ien
|
|
;INS - institution ien
|
|
;TIEN - team ien
|
|
;PDATA - pt name^pid^mt^pelig^pstat^statd^last^next^pc prov.^assoc. prov.
|
|
;CNAME - clinic name
|
|
;CIEN - clinic ien
|
|
;
|
|
S @STORE@(INS,TIEN,CIEN,PTIEN)=$E($P(PDATA,"^"),1,15) ;patient name
|
|
S $E(@STORE@(INS,TIEN,CIEN,PTIEN),18)=$E($P(PDATA,"^",2),6,10) ;primary long id last 4 plus P
|
|
S $E(@STORE@(INS,TIEN,CIEN,PTIEN),25)=$P(PDATA,"^",3) ;means test category
|
|
S $E(@STORE@(INS,TIEN,CIEN,PTIEN),31)=$P(PDATA,"^",4) ;primary eligibility
|
|
;Removed by patch 174
|
|
;S $E(@STORE@(INS,TIEN,CIEN,PTIEN),31)=$P(PDATA,"^",5) ;patient status
|
|
;S $E(@STORE@(INS,TIEN,CIEN,PTIEN),35)=$P(PDATA,"^",6) ;status date
|
|
S $E(@STORE@(INS,TIEN,CIEN,PTIEN),42)=$P(PDATA,"^",7) ;last appointment
|
|
S $E(@STORE@(INS,TIEN,CIEN,PTIEN),54)=$P(PDATA,"^",8) ;next appointment
|
|
S $E(@STORE@(INS,TIEN,CIEN,PTIEN),66)=$E(CNAME,1,27) ;clinic name
|
|
S $E(@STORE@(INS,TIEN,CIEN,PTIEN),95)=$E($P(PDATA,U,9),1,18) ;PC prov.
|
|
S $E(@STORE@(INS,TIEN,CIEN,PTIEN),115)=$E($P(PDATA,U,10),1,18) ;Assoc. Prov.
|
|
Q
|
|
;
|
|
CHEAD(INS,TEAM,CLINIC) ;
|
|
;column headings
|
|
;
|
|
N EN,NEWP
|
|
W !
|
|
S NEWP=0
|
|
I IOST'?1"C-".E,$Y+5>(IOSL-6) D NEWP1^SCRPU3(.PAGE,TITL) S NEWP=1
|
|
I IOST?1"C-".E,$Y+5>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) S NEWP=1
|
|
I STOP Q
|
|
I NEWP W !,$G(@STORE@(INS)),!!,$G(@STORE@(INS,TEAM)),!
|
|
CH2 F EN="H0","H1","H2" W !,$G(@STORE@("SUBHEADER",EN))
|
|
Q
|
|
;
|