SCMCMHP2 ;ALB/CMM - Practitioner's Patients ; 12/12/00 3:46pm
;;5.3;Scheduling;**589**;AUG 13, 1993;Build 41
;
;Patch 589, copy of SCRPPAT2, modified for MH Practitioner's Patients Report
;
DRIVE ;
;driver module
N PRAC,INF,ARRY,ERROR,NXT,OKAY,PIEN,TPRC
S ARRY="^TMP(""SCARRAY"","_$J_")",ERROR="ERR"
S TPRC="^TMP(""SCRP"",$J,""PRACT"")" M @TPRC=PRACT
K @ARRY,@ERROR,PRACT
I @TPRC=1 D ALL^SCRPPAT3 ;all practitioners selected
S NXT=0
F S NXT=$O(@TPRC@(NXT)) Q:NXT=""!(NXT'?.N) D
.I @TPRC=0 S PIEN=NXT
.I @TPRC=1 S PIEN=$P(@TPRC@(NXT),"^")
.K @ARRY,@ERROR
.S OKAY=$$PTPR^SCAPMC14(PIEN,"","","",ARRY,ERROR) ;patients for practitioner
.I '+OKAY Q
.D LOOPPT(ARRY,PIEN) ;loop through patients for practitioner
K @ARRY,@ERROR,@TPRC
K:SUMM @STORE@("PT")
Q
;
LOOPPT(ARY,PRAC) ;loop through patients for practitioner
;ARY - array of patients for selected practitioner
;PRAC - practitioner ien
N NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,PTA,PTAN,TIEN
N PC,TNODE,TNAME,PINF,POSN,PRCP,CNAME
S NXT=0
F S NXT=$O(@ARY@(NXT)) Q:NXT=""!(NXT'?.N) D
.S NODE=$G(@ARY@(NXT))
.Q:NODE=""
.S PIEN=+$P(NODE,"^") ;ien of patient file entry
.S TPIEN=+$P(NODE,"^",3) ;ien of patient team position assignment
.S PTP=$G(^SCPT(404.43,TPIEN,0))
.Q:PTP=""
.S PTA=+$P(PTP,"^") ;patient team assignment ien (404.42)
.S PTAN=$G(^SCPT(404.42,PTA,0))
.Q:PTAN=""
.S TIEN=+$P(PTAN,"^",3) ;team file ien (404.51)
.I $G(TEAM)'=1,'$D(TEAM(TIEN)) Q ;not a selected team
.S TNODE=$G(^SCTM(404.51,TIEN,0))
.Q:TNODE="" I $G(INST)'=1,'$D(INST(+$P(TNODE,U,7))) Q
.S TNAME=$P(TNODE,"^") ;team name
.S TPI=+$P(PTP,"^",2) ;Team Position file ien (404.57)
.S TPN=$G(^SCTM(404.57,TPI,0))
.Q:TPN=""
.I $G(ROLE)'=1,'$D(ROLE(+$P(TPN,U,3))) Q ;not a selected role
.S POSN=$P(TPN,"^") ;position name
.D SETASCL^SCRPRAC2(TPI,.CNAME,.CLIEN) ;get clinics from multiple
.;S CLIEN=+$P(TPN,"^",9) ;associated clinic ien
.;commented next line off - clinic enrollment no longer needed SD*5.3*433
.;D CECHK(CLIEN,.CNAME,PIEN) ;is patient enrolled in associated clinic?
.;S CNAME=$P($G(^SC(CLIEN,0)),"^") ; SD*5.3*433 remove enroll check
.S PC=$S($P(PTP,"^",5)=0:0,1:1) ;primary care position 1or2-yes/0-no
.S PNAME=$P($G(^VA(200,+PRAC,0)),"^") ;clinician name
.Q:PNAME=""
.S PRCP=$P($$OKPREC2^SCMCLK(TPI,DT),U,2)
.D GETPINF(PIEN,.CLIEN,.PINF) ;get patient information and appointments
.S CNAME=$G(CNAME(0)) ;first line will capture position information
.S PINF=$G(PINF(0))
.I PINF="" D
..S PINF=PIEN_"^"_$$PDATA(PIEN,CNAME,CNAME,1)
.D FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
.D SETFORM(PIEN,.CNAME,.PINF)
SETFORM(PIEN,CNAME,PINF) ;Format for clinic info only for multiples
N SCCNT
S SCCNT=0 F S SCCNT=$O(PINF(SCCNT)) Q:SCCNT="" D FORMATAC(CNAME(SCCNT),PINF(SCCNT),PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
Q
GETPINF(PIEN,CLIEN,PINF) ;get patient info
N SCCNT
S SCCNT="" F S SCCNT=$O(CLIEN(SCCNT)) Q:SCCNT="" D
.S PINF(SCCNT)=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN(SCCNT),CNAME(SCCNT),1)
.;Patch 589 -- format SSN (3rd piece) to xxxxxNNNN
.S $P(PINF(SCCNT),U,3)="xxxxx"_$E($P(PINF(SCCNT),U,3),6,9)
Q
;
FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
;CNAME - clinic name
;PINF - patient/clinic data
;PC - primary care 1/0
;TIEN - team file ien (#404.51)
;TNAME - team name
;PRAC - practitioner ien (#200)
;PNAME - practitioner name
;POSN - position name
;TPI - team position ien (#404.57)
;PRCP - preceptor name
;
N IIEN,INAME,ERR
;patch 589 - copied SETUP from SCRPPAT3, put in this routine, changed call
S ERR=$$SETUP^SCMCMHP2(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
I ERR Q
;
I SORT=1 D STOR(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI) ;sort division,team,clinician
I SORT=2 D STOR(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI) ;sort division,clinician,team
I SORT=3 D STOR(1,PRAC,1,PINF,PNAME,"T3",TPI)
Q
;
FORMATAC(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
;CNAME - clinic name
;PINF - patient/clinic data
;PC - primary care 1/0
;TIEN - team file ien (#404.51)
;TNAME - team name
;PRAC - practitioner ien (#200)
;PNAME - practitioner name
;POSN - position name
;TPI - team position ien (#404.57)
;PRCP - preceptor name
;
N IIEN,INAME,ERR
;patch 589 - copied SETUP from SCRPPAT3, put in this routine, changed call
S ERR=$$SETUP^SCMCMHP2(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
I ERR Q
;
I SORT=1 D STORA(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,team,practitioner
I SORT=2 D STORA(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,practitioner,team
I SORT=3 D STORA(1,PRAC,1,PINF,PNAME,"T3",TPI,SCCNT)
Q
;
STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
;IIEN - ien institution
;SEC - second sort subscript, IEN team or IEN practitioner
;TRD - third sort subscript, IEN team or IEN practitioner
;PINF - patient/clinic info
;PNAME - practitioner name
;TNAME - team name
;TPI - team position ien
;
N PIEN,PTNAME,PID
S PIEN=+$P(PINF,"^") ;patient ien
S PTNAME=$E($P(PINF,"^",2),1,10) ;patient name
Q:$D(@STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN))
S @STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)=""
I 'SUMM,'$D(@STORE@("PTOT",IIEN,SEC,TRD,PIEN)) D
.;count each unique patient for any given practitioner for grand total
.S @STORE@("PTOT",IIEN,SEC,TRD,PIEN)=""
.S @STORE@("TOTAL",IIEN,PRAC,0)=$G(@STORE@("TOTAL",IIEN,PRAC,0))+1 ;patient count by practitioner
;
S @STORE@("TOTAL",IIEN,PRAC,$S(SORT=3:1,1:TIEN),TPI)=$G(@STORE@("TOTAL",IIEN,PRAC,$S(SORT=3:1,1:TIEN),TPI))+1 ;patient count by practitioner and team
Q:SUMM
;
S @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME
S PID=$P(PINF,"^",3),PID=$TR(PID,"-","")
S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),13)=PID ;ssn
;Removed by patch 589 for Mental Health
;S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),25)=$P(PINF,"^",4) ;means test status
S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),31)=$P(PINF,"^",5) ;eligibility
;Removed by patch 174
;S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),40)=$P(PINF,"^",6) ;patient status
S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),42)=$P(PINF,"^",8) ;last appt
S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),54)=$P(PINF,"^",9) ;nxt appt
S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),66)=$E(CNAME,1,15) ;clinic
Q
STORA(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
I '$D(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT)) D
.S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),42)=$P(PINF,"^",8) ;last appt
.S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),54)=$P(PINF,"^",9) ;nxt appt
.S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),66)=$E(CNAME,1,15) ;clinic
.Q
Q
PDATA(DFN,CLNEN,CNAME,FLAG) ;
; Patch 589 - copied from SCRPEC so that the SSN can be formatted:
; xxxxxNNNN
;
;Collect and format data for report
;
N NODE,NAME,PID,PELIG,MT,PSTAT,STATD,DATA,LAST,NEXT
S DATA=""
S NODE=$G(^DPT(DFN,0))
S NAME=$P(NODE,"^") ;patient name
S PID=$P($G(^DPT(DFN,.36)),"^",3),PID=$TR(PID,"-","") ;PID without '-'s
;Patc 589 - format SSN
S PID="xxxxx"_$E(PID,6,9)
S MT=$$LST^DGMTU(DFN),MT=$P(MT,"^",4) ;means test status SD*5.3*431
S PELIG=$$ELIG^SCRPU3(DFN) ;primary eligibility
S PSTAT="N/A"
S STATD=""
S LAST=$$GETLAST^SCRPU3(DFN,.CLNEN) ;last Clinic appointment
S NEXT=$$GETNEXT^SCRPU3(DFN,.CLNEN) ;next clinic appointment
;I '$D(FLAG) S DATA=$$FORMAT^SCRPEC2(PTIEN,INS,TIEN,PDATA,CNAME,CIEN)
I '$D(FLAG) S DATA=$$FORMAT^SCRPEC2(NAME,PID,MT,PELIG,PSTAT,STATD,LAST,NEXT,CNAME),DATA=$E(NAME,1,12)_"^"_DATA
I $D(FLAG) S DATA=$E(NAME,1,12)_"^"_PID_"^"_MT_"^"_PELIG_"^"_PSTAT_"^"_STATD_"^"_LAST_"^"_NEXT
Q DATA
;
SETUP(IIEN,INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ;
;setup data
S IIEN=+$P($G(^SCTM(404.51,TIEN,0)),"^",7) ;institution ien
S INAME=$P($G(^DIC(4,IIEN,0)),"^") ;institution name
I INAME="" S INAME="[BAD DATA]"
;
I PNAME="" S PNAME="[BAD DATA]"
I TNAME="" S TNAME="[BAD DATA]"
I $G(SORT)=3 S IIEN=1,TIEN=1
; Patch 589 - changed Practitioner to Clinician
I '$D(@STORE@("PN",IIEN,PRAC,TIEN,TPI)) S @STORE@("PN",IIEN,PRAC,TIEN,TPI)="Clinician: "_PNAME_$S(SORT=3:"",1:" ("_POSN_")")
I $L(PRCP) S @STORE@("PN",IIEN,PRAC,TIEN,TPI,"PRCP")=" Preceptor: "_PRCP
I '$D(@STORE@("TN",IIEN,$S($G(SORT)=3:1,1:TIEN))) S @STORE@("TN",IIEN,$S($G(SORT)=3:1,1:TIEN))=" Team: "_TNAME
;
I '$D(@STORE@("I",$S($G(SORT)=3:"S3",1:INAME),IIEN)) S @STORE@("I",$S($G(SORT)=3:"S3",1:INAME),IIEN)="",@STORE@(IIEN)=$S(SORT=3:"",1:" Division: "_INAME)
S @STORE@("T",IIEN,$S($G(SORT)=3:"T3",1:TNAME),$S($G(SORT)=3:1,1:TIEN))=""
I '$D(@STORE@("P",IIEN,PNAME,PRAC,TPI)) S @STORE@("P",IIEN,PNAME,PRAC,TPI)=""
I '$D(@STORE@("TOTAL",IIEN,PRAC,0)) S @STORE@("TOTAL",IIEN,PRAC,0)=0
I '$D(@STORE@("TOTAL",IIEN,PRAC,TIEN)) S @STORE@("TOTAL",IIEN,PRAC,TIEN)=0
;
S @STORE@("TH",IIEN,PRAC)="Patient Count for "_PNAME_": "
S @STORE@("TH",IIEN,PRAC,TIEN,TPI)="Patient Count for "_PNAME_": "
N SCX
S SCX=$E(PNAME,1,22),$E(SCX,25)=$E(POSN,1,22),$E(SCX,49)=$E(TNAME,1,22)
S @STORE@("SUM0",IIEN,PRAC,TIEN,TPI)=SCX
;
S @STORE@("TH",IIEN)="** Note: Patient Panel Count is a count of unique patients for each practitioner"
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCMHP2 9262 printed Sep 23, 2025@20:17:15 Page 2
SCMCMHP2 ;ALB/CMM - Practitioner's Patients ; 12/12/00 3:46pm
+1 ;;5.3;Scheduling;**589**;AUG 13, 1993;Build 41
+2 ;
+3 ;Patch 589, copy of SCRPPAT2, modified for MH Practitioner's Patients Report
+4 ;
DRIVE ;
+1 ;driver module
+2 NEW PRAC,INF,ARRY,ERROR,NXT,OKAY,PIEN,TPRC
+3 SET ARRY="^TMP(""SCARRAY"","_$JOB_")"
SET ERROR="ERR"
+4 SET TPRC="^TMP(""SCRP"",$J,""PRACT"")"
MERGE @TPRC=PRACT
+5 KILL @ARRY,@ERROR,PRACT
+6 ;all practitioners selected
IF @TPRC=1
DO ALL^SCRPPAT3
+7 SET NXT=0
+8 FOR
SET NXT=$ORDER(@TPRC@(NXT))
if NXT=""!(NXT'?.N)
QUIT
Begin DoDot:1
+9 IF @TPRC=0
SET PIEN=NXT
+10 IF @TPRC=1
SET PIEN=$PIECE(@TPRC@(NXT),"^")
+11 KILL @ARRY,@ERROR
+12 ;patients for practitioner
SET OKAY=$$PTPR^SCAPMC14(PIEN,"","","",ARRY,ERROR)
+13 IF '+OKAY
QUIT
+14 ;loop through patients for practitioner
DO LOOPPT(ARRY,PIEN)
End DoDot:1
+15 KILL @ARRY,@ERROR,@TPRC
+16 if SUMM
KILL @STORE@("PT")
+17 QUIT
+18 ;
LOOPPT(ARY,PRAC) ;loop through patients for practitioner
+1 ;ARY - array of patients for selected practitioner
+2 ;PRAC - practitioner ien
+3 NEW NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,PTA,PTAN,TIEN
+4 NEW PC,TNODE,TNAME,PINF,POSN,PRCP,CNAME
+5 SET NXT=0
+6 FOR
SET NXT=$ORDER(@ARY@(NXT))
if NXT=""!(NXT'?.N)
QUIT
Begin DoDot:1
+7 SET NODE=$GET(@ARY@(NXT))
+8 if NODE=""
QUIT
+9 ;ien of patient file entry
SET PIEN=+$PIECE(NODE,"^")
+10 ;ien of patient team position assignment
SET TPIEN=+$PIECE(NODE,"^",3)
+11 SET PTP=$GET(^SCPT(404.43,TPIEN,0))
+12 if PTP=""
QUIT
+13 ;patient team assignment ien (404.42)
SET PTA=+$PIECE(PTP,"^")
+14 SET PTAN=$GET(^SCPT(404.42,PTA,0))
+15 if PTAN=""
QUIT
+16 ;team file ien (404.51)
SET TIEN=+$PIECE(PTAN,"^",3)
+17 ;not a selected team
IF $GET(TEAM)'=1
IF '$DATA(TEAM(TIEN))
QUIT
+18 SET TNODE=$GET(^SCTM(404.51,TIEN,0))
+19 if TNODE=""
QUIT
IF $GET(INST)'=1
IF '$DATA(INST(+$PIECE(TNODE,U,7)))
QUIT
+20 ;team name
SET TNAME=$PIECE(TNODE,"^")
+21 ;Team Position file ien (404.57)
SET TPI=+$PIECE(PTP,"^",2)
+22 SET TPN=$GET(^SCTM(404.57,TPI,0))
+23 if TPN=""
QUIT
+24 ;not a selected role
IF $GET(ROLE)'=1
IF '$DATA(ROLE(+$PIECE(TPN,U,3)))
QUIT
+25 ;position name
SET POSN=$PIECE(TPN,"^")
+26 ;get clinics from multiple
DO SETASCL^SCRPRAC2(TPI,.CNAME,.CLIEN)
+27 ;S CLIEN=+$P(TPN,"^",9) ;associated clinic ien
+28 ;commented next line off - clinic enrollment no longer needed SD*5.3*433
+29 ;D CECHK(CLIEN,.CNAME,PIEN) ;is patient enrolled in associated clinic?
+30 ;S CNAME=$P($G(^SC(CLIEN,0)),"^") ; SD*5.3*433 remove enroll check
+31 ;primary care position 1or2-yes/0-no
SET PC=$SELECT($PIECE(PTP,"^",5)=0:0,1:1)
+32 ;clinician name
SET PNAME=$PIECE($GET(^VA(200,+PRAC,0)),"^")
+33 if PNAME=""
QUIT
+34 SET PRCP=$PIECE($$OKPREC2^SCMCLK(TPI,DT),U,2)
+35 ;get patient information and appointments
DO GETPINF(PIEN,.CLIEN,.PINF)
+36 ;first line will capture position information
SET CNAME=$GET(CNAME(0))
+37 SET PINF=$GET(PINF(0))
+38 IF PINF=""
Begin DoDot:2
+39 SET PINF=PIEN_"^"_$$PDATA(PIEN,CNAME,CNAME,1)
End DoDot:2
+40 DO FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
+41 DO SETFORM(PIEN,.CNAME,.PINF)
End DoDot:1
SETFORM(PIEN,CNAME,PINF) ;Format for clinic info only for multiples
+1 NEW SCCNT
+2 SET SCCNT=0
FOR
SET SCCNT=$ORDER(PINF(SCCNT))
if SCCNT=""
QUIT
DO FORMATAC(CNAME(SCCNT),PINF(SCCNT),PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
+3 QUIT
GETPINF(PIEN,CLIEN,PINF) ;get patient info
+1 NEW SCCNT
+2 SET SCCNT=""
FOR
SET SCCNT=$ORDER(CLIEN(SCCNT))
if SCCNT=""
QUIT
Begin DoDot:1
+3 SET PINF(SCCNT)=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN(SCCNT),CNAME(SCCNT),1)
+4 ;Patch 589 -- format SSN (3rd piece) to xxxxxNNNN
+5 SET $PIECE(PINF(SCCNT),U,3)="xxxxx"_$EXTRACT($PIECE(PINF(SCCNT),U,3),6,9)
End DoDot:1
+6 QUIT
+7 ;
FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
+1 ;CNAME - clinic name
+2 ;PINF - patient/clinic data
+3 ;PC - primary care 1/0
+4 ;TIEN - team file ien (#404.51)
+5 ;TNAME - team name
+6 ;PRAC - practitioner ien (#200)
+7 ;PNAME - practitioner name
+8 ;POSN - position name
+9 ;TPI - team position ien (#404.57)
+10 ;PRCP - preceptor name
+11 ;
+12 NEW IIEN,INAME,ERR
+13 ;patch 589 - copied SETUP from SCRPPAT3, put in this routine, changed call
+14 SET ERR=$$SETUP^SCMCMHP2(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
+15 IF ERR
QUIT
+16 ;
+17 ;sort division,team,clinician
IF SORT=1
DO STOR(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI)
+18 ;sort division,clinician,team
IF SORT=2
DO STOR(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI)
+19 IF SORT=3
DO STOR(1,PRAC,1,PINF,PNAME,"T3",TPI)
+20 QUIT
+21 ;
FORMATAC(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display
+1 ;CNAME - clinic name
+2 ;PINF - patient/clinic data
+3 ;PC - primary care 1/0
+4 ;TIEN - team file ien (#404.51)
+5 ;TNAME - team name
+6 ;PRAC - practitioner ien (#200)
+7 ;PNAME - practitioner name
+8 ;POSN - position name
+9 ;TPI - team position ien (#404.57)
+10 ;PRCP - preceptor name
+11 ;
+12 NEW IIEN,INAME,ERR
+13 ;patch 589 - copied SETUP from SCRPPAT3, put in this routine, changed call
+14 SET ERR=$$SETUP^SCMCMHP2(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP)
+15 IF ERR
QUIT
+16 ;
+17 ;sort division,team,practitioner
IF SORT=1
DO STORA(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI,SCCNT)
+18 ;sort division,practitioner,team
IF SORT=2
DO STORA(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI,SCCNT)
+19 IF SORT=3
DO STORA(1,PRAC,1,PINF,PNAME,"T3",TPI,SCCNT)
+20 QUIT
+21 ;
STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
+1 ;IIEN - ien institution
+2 ;SEC - second sort subscript, IEN team or IEN practitioner
+3 ;TRD - third sort subscript, IEN team or IEN practitioner
+4 ;PINF - patient/clinic info
+5 ;PNAME - practitioner name
+6 ;TNAME - team name
+7 ;TPI - team position ien
+8 ;
+9 NEW PIEN,PTNAME,PID
+10 ;patient ien
SET PIEN=+$PIECE(PINF,"^")
+11 ;patient name
SET PTNAME=$EXTRACT($PIECE(PINF,"^",2),1,10)
+12 if $DATA(@STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN))
QUIT
+13 SET @STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)=""
+14 IF 'SUMM
IF '$DATA(@STORE@("PTOT",IIEN,SEC,TRD,PIEN))
Begin DoDot:1
+15 ;count each unique patient for any given practitioner for grand total
+16 SET @STORE@("PTOT",IIEN,SEC,TRD,PIEN)=""
+17 ;patient count by practitioner
SET @STORE@("TOTAL",IIEN,PRAC,0)=$GET(@STORE@("TOTAL",IIEN,PRAC,0))+1
End DoDot:1
+18 ;
+19 ;patient count by practitioner and team
SET @STORE@("TOTAL",IIEN,PRAC,$SELECT(SORT=3:1,1:TIEN),TPI)=$GET(@STORE@("TOTAL",IIEN,PRAC,$SELECT(SORT=3:1,1:TIEN),TPI))+1
+20 if SUMM
QUIT
+21 ;
+22 SET @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME
+23 SET PID=$PIECE(PINF,"^",3)
SET PID=$TRANSLATE(PID,"-","")
+24 ;ssn
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),13)=PID
+25 ;Removed by patch 589 for Mental Health
+26 ;S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),25)=$P(PINF,"^",4) ;means test status
+27 ;eligibility
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),31)=$PIECE(PINF,"^",5)
+28 ;Removed by patch 174
+29 ;S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),40)=$P(PINF,"^",6) ;patient status
+30 ;last appt
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),42)=$PIECE(PINF,"^",8)
+31 ;nxt appt
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),54)=$PIECE(PINF,"^",9)
+32 ;clinic
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN),66)=$EXTRACT(CNAME,1,15)
+33 QUIT
STORA(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ;
+1 IF '$DATA(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT))
Begin DoDot:1
+2 ;last appt
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),42)=$PIECE(PINF,"^",8)
+3 ;nxt appt
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),54)=$PIECE(PINF,"^",9)
+4 ;clinic
SET $EXTRACT(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),66)=$EXTRACT(CNAME,1,15)
+5 QUIT
End DoDot:1
+6 QUIT
PDATA(DFN,CLNEN,CNAME,FLAG) ;
+1 ; Patch 589 - copied from SCRPEC so that the SSN can be formatted:
+2 ; xxxxxNNNN
+3 ;
+4 ;Collect and format data for report
+5 ;
+6 NEW NODE,NAME,PID,PELIG,MT,PSTAT,STATD,DATA,LAST,NEXT
+7 SET DATA=""
+8 SET NODE=$GET(^DPT(DFN,0))
+9 ;patient name
SET NAME=$PIECE(NODE,"^")
+10 ;PID without '-'s
SET PID=$PIECE($GET(^DPT(DFN,.36)),"^",3)
SET PID=$TRANSLATE(PID,"-","")
+11 ;Patc 589 - format SSN
+12 SET PID="xxxxx"_$EXTRACT(PID,6,9)
+13 ;means test status SD*5.3*431
SET MT=$$LST^DGMTU(DFN)
SET MT=$PIECE(MT,"^",4)
+14 ;primary eligibility
SET PELIG=$$ELIG^SCRPU3(DFN)
+15 SET PSTAT="N/A"
+16 SET STATD=""
+17 ;last Clinic appointment
SET LAST=$$GETLAST^SCRPU3(DFN,.CLNEN)
+18 ;next clinic appointment
SET NEXT=$$GETNEXT^SCRPU3(DFN,.CLNEN)
+19 ;I '$D(FLAG) S DATA=$$FORMAT^SCRPEC2(PTIEN,INS,TIEN,PDATA,CNAME,CIEN)
+20 IF '$DATA(FLAG)
SET DATA=$$FORMAT^SCRPEC2(NAME,PID,MT,PELIG,PSTAT,STATD,LAST,NEXT,CNAME)
SET DATA=$EXTRACT(NAME,1,12)_"^"_DATA
+21 IF $DATA(FLAG)
SET DATA=$EXTRACT(NAME,1,12)_"^"_PID_"^"_MT_"^"_PELIG_"^"_PSTAT_"^"_STATD_"^"_LAST_"^"_NEXT
+22 QUIT DATA
+23 ;
SETUP(IIEN,INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ;
+1 ;setup data
+2 ;institution ien
SET IIEN=+$PIECE($GET(^SCTM(404.51,TIEN,0)),"^",7)
+3 ;institution name
SET INAME=$PIECE($GET(^DIC(4,IIEN,0)),"^")
+4 IF INAME=""
SET INAME="[BAD DATA]"
+5 ;
+6 IF PNAME=""
SET PNAME="[BAD DATA]"
+7 IF TNAME=""
SET TNAME="[BAD DATA]"
+8 IF $GET(SORT)=3
SET IIEN=1
SET TIEN=1
+9 ; Patch 589 - changed Practitioner to Clinician
+10 IF '$DATA(@STORE@("PN",IIEN,PRAC,TIEN,TPI))
SET @STORE@("PN",IIEN,PRAC,TIEN,TPI)="Clinician: "_PNAME_$SELECT(SORT=3:"",1:" ("_POSN_")")
+11 IF $LENGTH(PRCP)
SET @STORE@("PN",IIEN,PRAC,TIEN,TPI,"PRCP")=" Preceptor: "_PRCP
+12 IF '$DATA(@STORE@("TN",IIEN,$SELECT($GET(SORT)=3:1,1:TIEN)))
SET @STORE@("TN",IIEN,$SELECT($GET(SORT)=3:1,1:TIEN))=" Team: "_TNAME
+13 ;
+14 IF '$DATA(@STORE@("I",$SELECT($GET(SORT)=3:"S3",1:INAME),IIEN))
SET @STORE@("I",$SELECT($GET(SORT)=3:"S3",1:INAME),IIEN)=""
SET @STORE@(IIEN)=$SELECT(SORT=3:"",1:" Division: "_INAME)
+15 SET @STORE@("T",IIEN,$SELECT($GET(SORT)=3:"T3",1:TNAME),$SELECT($GET(SORT)=3:1,1:TIEN))=""
+16 IF '$DATA(@STORE@("P",IIEN,PNAME,PRAC,TPI))
SET @STORE@("P",IIEN,PNAME,PRAC,TPI)=""
+17 IF '$DATA(@STORE@("TOTAL",IIEN,PRAC,0))
SET @STORE@("TOTAL",IIEN,PRAC,0)=0
+18 IF '$DATA(@STORE@("TOTAL",IIEN,PRAC,TIEN))
SET @STORE@("TOTAL",IIEN,PRAC,TIEN)=0
+19 ;
+20 SET @STORE@("TH",IIEN,PRAC)="Patient Count for "_PNAME_": "
+21 SET @STORE@("TH",IIEN,PRAC,TIEN,TPI)="Patient Count for "_PNAME_": "
+22 NEW SCX
+23 SET SCX=$EXTRACT(PNAME,1,22)
SET $EXTRACT(SCX,25)=$EXTRACT(POSN,1,22)
SET $EXTRACT(SCX,49)=$EXTRACT(TNAME,1,22)
+24 SET @STORE@("SUM0",IIEN,PRAC,TIEN,TPI)=SCX
+25 ;
+26 SET @STORE@("TH",IIEN)="** Note: Patient Panel Count is a count of unique patients for each practitioner"
+27 QUIT 0
