- SCRPPAT3 ;ALB/CMM - Practitioner's Patients ; 8/30/99 3:14pm
- ;;5.3;Scheduling;**41,52,148,174,181,177,297,526,520,535**;AUG 13, 1993;Build 3
- ;
- ;Listing of Practitioner's Patients
- ;
- PAT(INS,SEC,TRD,SEC3,ST3,ST4,POS) ;
- ;writes patients for position/practitioner
- N PTN,PT,FIRST
- S PTN="",FIRST=1
- I SUMM D TOTAL1^SCRPPAT3(INS,SEC,TRD,POS) Q ;Summary only
- F S PTN=$O(@STORE@("PT",INS,SEC,TRD,POS,PTN)) Q:PTN=""!(STOP) D
- .S PT=0
- .F S PT=$O(@STORE@("PT",INS,SEC,TRD,POS,PTN,PT)) Q:'PT!(STOP) D
- ..I FIRST D HEADER S FIRST=0
- ..W !,$G(@STORE@(INS,SEC,TRD,POS,PT)) ;print patient detail line
- ..N SCCN
- ..S SCCN=""
- ..F S SCCN=$O(@STORE@(INS,SEC,TRD,POS,PT,SCCN)) Q:SCCN="" D
- ...W !,$G(@STORE@(INS,SEC,TRD,POS,PT,SCCN)) ;print patient detail line
- ...Q:STOP
- ..Q
- .I (IOST'?1"C-".E),$Y>(IOSL-5) S MORE=0 D NEWP1^SCRPU3(.PAGE,TITL) D:'STOP HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) D:(('FIRST&'STOP)!($G(SORT)=3)) HEADER
- .I (IOST?1"C-".E),$Y>(IOSL-5) S MORE=0 D HOLD^SCRPU3(.PAGE,TITL) D:'STOP HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) D:'FIRST&'STOP HEADER
- .Q
- Q
- ;
- SPRINT(STORE,IOP,TITL,SORT) ; Summary Print Only
- ;STORE - global location of data
- ;IOP - device to print to
- ;TITL - title of report
- ;SORT - sort order 1-div,team,pract/2-div,pract,team
- ;
- N PAGE
- S PAGE=1,STOP=0
- D OPEN^SCRPU3
- Q:$G(POP)
- D TITLE^SCRPU3(.PAGE,TITL)
- D CLOSE^SCRPU3
- Q
- ;
- TOTAL1(INS,SEC,TRD,POS) ;
- ;print team/practitioner total
- N TEM,PRC
- I SORT=1 S TEM=SEC,PRC=TRD
- I SORT=2!(SORT=3) S TEM=TRD,PRC=SEC
- W !!,$G(@STORE@("TH",INS,PRC,TEM,POS)),$G(@STORE@("TOTAL",INS,PRC,TEM,POS))
- Q
- ;
- HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) ;
- I (SEC3="""TN""")&($D(@ST4@(INS,TRD,SEC))) D
- .W !,$G(@ST3@(INS,SEC)) ;write team (sort 1)
- .W !,$G(@STORE@(INS))
- .W !,$G(@ST4@(INS,TRD,SEC,POS)) ;write practitioner (sort 2)
- .I $L($G(@STORE@("PN",INS,TRD,SEC,POS,"PRCP"))) W !,@STORE@("PN",INS,TRD,SEC,POS,"PRCP")
- .W !
- I (SEC3="""PN""")&($D(@ST3@(INS,SEC,TRD))) D
- .W !,$G(@ST3@(INS,SEC,TRD,POS)) ;write practitioner (sort 1)
- .I $G(SORT)'=3 I $L($G(@STORE@("PN",INS,SEC,TRD,POS,"PRCP"))) W !,@STORE@("PN",INS,SEC,TRD,POS,"PRCP")
- .I $G(SORT)'=3 W !,$G(@ST4@(INS,TRD)) ;write team (sort 2)
- .W !,$G(@STORE@(INS))
- Q
- ;
- Q:$G(MORE)
- I SORT=3 S MORE=1
- N NXT
- F NXT="H1","H2","H3" W !,$G(@STORE@(NXT))
- W !
- Q
- ;
- SHEAD ;
- S @STORE@("H2")="Pt Name"
- S $E(@STORE@("H2"),15)="Pt ID"
- S $E(@STORE@("H1"),25)="M.T."
- S $E(@STORE@("H2"),25)="Stat"
- S $E(@STORE@("H1"),31)="Prim"
- S $E(@STORE@("H2"),31)="Elig"
- ;Removed by patch 174
- ;S $E(@STORE@("H1"),39)="Pat"
- ;S $E(@STORE@("H2"),39)="Stat"
- S $E(@STORE@("H1"),42)="Last"
- S $E(@STORE@("H2"),42)="Appt"
- S $E(@STORE@("H1"),54)="Next"
- S $E(@STORE@("H2"),54)="Appt"
- S $E(@STORE@("H2"),66)="Clinic"
- S $P(@STORE@("H3"),"=",81)=""
- Q
- ALL ;
- ;get all practitioners for all teams selected
- I TEAM=1 D TALL ;all teams selected
- N TIEN,OKAY,XLIST,YLIST,SCTP,SCI,SCDT
- S TIEN=""
- F S TIEN=$O(TEAM(TIEN)) Q:TIEN=""!(TIEN'?.N) D
- .I $D(TEAM(TIEN)) D
- ..K XLIST
- ..S OKAY=$$TPTM^SCAPMC(TIEN,"","","","XLIST","ERROR")
- ..S SCTP=0 F S SCTP=$O(XLIST("SCTP",TIEN,SCTP)) Q:'SCTP D
- ...K YLIST S SCDT="SCDT",(SCDT("BEGIN"),SCDT("END"))=DT,SCDT("INCL")=0
- ...S OKAY=$$PRTP^SCAPMC(SCTP,.SCDT,"YLIST","ERROR",1,0)
- ...S SCI=0 F S SCI=$O(YLIST(SCI)) Q:'SCI D
- ....S @TPRC@(0)=$G(@TPRC@(0))+1
- ....S @TPRC@(@TPRC@(0))=YLIST(SCI)
- Q
- ;
- TALL ;
- ;get all active team for divisions selected
- N NXT,IIEN,NODE
- S NXT=0,IIEN=""
- ;$O through team file and find all active teams for selected divisions
- F S IIEN=$O(^SCTM(404.51,"AINST",IIEN)) Q:IIEN="" D
- .I INST=1!$D(INST(IIEN)) D
- ..S TIEN=0
- ..F S TIEN=$O(^SCTM(404.51,"AINST",IIEN,TIEN)) Q:TIEN="" D
- ...I $$ACTTM^SCMCTMU(TIEN) S TEAM(TIEN)=""
- Q
- ;
- 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
- I '$D(@STORE@("PN",IIEN,PRAC,TIEN,TPI)) S @STORE@("PN",IIEN,PRAC,TIEN,TPI)="Practitioner: "_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[HSCRPPAT3 5319 printed Jan 18, 2025@03:43:58 Page 2
- SCRPPAT3 ;ALB/CMM - Practitioner's Patients ; 8/30/99 3:14pm
- +1 ;;5.3;Scheduling;**41,52,148,174,181,177,297,526,520,535**;AUG 13, 1993;Build 3
- +2 ;
- +3 ;Listing of Practitioner's Patients
- +4 ;
- PAT(INS,SEC,TRD,SEC3,ST3,ST4,POS) ;
- +1 ;writes patients for position/practitioner
- +2 NEW PTN,PT,FIRST
- +3 SET PTN=""
- SET FIRST=1
- +4 ;Summary only
- IF SUMM
- DO TOTAL1^SCRPPAT3(INS,SEC,TRD,POS)
- QUIT
- +5 FOR
- SET PTN=$ORDER(@STORE@("PT",INS,SEC,TRD,POS,PTN))
- if PTN=""!(STOP)
- QUIT
- Begin DoDot:1
- +6 SET PT=0
- +7 FOR
- SET PT=$ORDER(@STORE@("PT",INS,SEC,TRD,POS,PTN,PT))
- if 'PT!(STOP)
- QUIT
- Begin DoDot:2
- +8 IF FIRST
- DO HEADER
- SET FIRST=0
- +9 ;print patient detail line
- WRITE !,$GET(@STORE@(INS,SEC,TRD,POS,PT))
- +10 NEW SCCN
- +11 SET SCCN=""
- +12 FOR
- SET SCCN=$ORDER(@STORE@(INS,SEC,TRD,POS,PT,SCCN))
- if SCCN=""
- QUIT
- Begin DoDot:3
- +13 ;print patient detail line
- WRITE !,$GET(@STORE@(INS,SEC,TRD,POS,PT,SCCN))
- +14 if STOP
- QUIT
- End DoDot:3
- +15 QUIT
- End DoDot:2
- +16 IF (IOST'?1"C-".E)
- IF $Y>(IOSL-5)
- SET MORE=0
- DO NEWP1^SCRPU3(.PAGE,TITL)
- if 'STOP
- DO HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS)
- if (('FIRST&'STOP)!($GET(SORT)=3))
- DO HEADER
- +17 IF (IOST?1"C-".E)
- IF $Y>(IOSL-5)
- SET MORE=0
- DO HOLD^SCRPU3(.PAGE,TITL)
- if 'STOP
- DO HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS)
- if 'FIRST&'STOP
- DO HEADER
- +18 QUIT
- End DoDot:1
- +19 QUIT
- +20 ;
- SPRINT(STORE,IOP,TITL,SORT) ; Summary Print Only
- +1 ;STORE - global location of data
- +2 ;IOP - device to print to
- +3 ;TITL - title of report
- +4 ;SORT - sort order 1-div,team,pract/2-div,pract,team
- +5 ;
- +6 NEW PAGE
- +7 SET PAGE=1
- SET STOP=0
- +8 DO OPEN^SCRPU3
- +9 if $GET(POP)
- QUIT
- +10 DO TITLE^SCRPU3(.PAGE,TITL)
- +11 DO CLOSE^SCRPU3
- +12 QUIT
- +13 ;
- TOTAL1(INS,SEC,TRD,POS) ;
- +1 ;print team/practitioner total
- +2 NEW TEM,PRC
- +3 IF SORT=1
- SET TEM=SEC
- SET PRC=TRD
- +4 IF SORT=2!(SORT=3)
- SET TEM=TRD
- SET PRC=SEC
- +5 WRITE !!,$GET(@STORE@("TH",INS,PRC,TEM,POS)),$GET(@STORE@("TOTAL",INS,PRC,TEM,POS))
- +6 QUIT
- +7 ;
- HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) ;
- +1 IF (SEC3="""TN""")&($DATA(@ST4@(INS,TRD,SEC)))
- Begin DoDot:1
- +2 ;write team (sort 1)
- WRITE !,$GET(@ST3@(INS,SEC))
- +3 WRITE !,$GET(@STORE@(INS))
- +4 ;write practitioner (sort 2)
- WRITE !,$GET(@ST4@(INS,TRD,SEC,POS))
- +5 IF $LENGTH($GET(@STORE@("PN",INS,TRD,SEC,POS,"PRCP")))
- WRITE !,@STORE@("PN",INS,TRD,SEC,POS,"PRCP")
- +6 WRITE !
- End DoDot:1
- +7 IF (SEC3="""PN""")&($DATA(@ST3@(INS,SEC,TRD)))
- Begin DoDot:1
- +8 ;write practitioner (sort 1)
- WRITE !,$GET(@ST3@(INS,SEC,TRD,POS))
- +9 IF $GET(SORT)'=3
- IF $LENGTH($GET(@STORE@("PN",INS,SEC,TRD,POS,"PRCP")))
- WRITE !,@STORE@("PN",INS,SEC,TRD,POS,"PRCP")
- +10 ;write team (sort 2)
- IF $GET(SORT)'=3
- WRITE !,$GET(@ST4@(INS,TRD))
- +11 WRITE !,$GET(@STORE@(INS))
- End DoDot:1
- +12 QUIT
- +13 ;
- +1 if $GET(MORE)
- QUIT
- +2 IF SORT=3
- SET MORE=1
- +3 NEW NXT
- +4 FOR NXT="H1","H2","H3"
- WRITE !,$GET(@STORE@(NXT))
- +5 WRITE !
- +6 QUIT
- +7 ;
- SHEAD ;
- +1 SET @STORE@("H2")="Pt Name"
- +2 SET $EXTRACT(@STORE@("H2"),15)="Pt ID"
- +3 SET $EXTRACT(@STORE@("H1"),25)="M.T."
- +4 SET $EXTRACT(@STORE@("H2"),25)="Stat"
- +5 SET $EXTRACT(@STORE@("H1"),31)="Prim"
- +6 SET $EXTRACT(@STORE@("H2"),31)="Elig"
- +7 ;Removed by patch 174
- +8 ;S $E(@STORE@("H1"),39)="Pat"
- +9 ;S $E(@STORE@("H2"),39)="Stat"
- +10 SET $EXTRACT(@STORE@("H1"),42)="Last"
- +11 SET $EXTRACT(@STORE@("H2"),42)="Appt"
- +12 SET $EXTRACT(@STORE@("H1"),54)="Next"
- +13 SET $EXTRACT(@STORE@("H2"),54)="Appt"
- +14 SET $EXTRACT(@STORE@("H2"),66)="Clinic"
- +15 SET $PIECE(@STORE@("H3"),"=",81)=""
- +16 QUIT
- ALL ;
- +1 ;get all practitioners for all teams selected
- +2 ;all teams selected
- IF TEAM=1
- DO TALL
- +3 NEW TIEN,OKAY,XLIST,YLIST,SCTP,SCI,SCDT
- +4 SET TIEN=""
- +5 FOR
- SET TIEN=$ORDER(TEAM(TIEN))
- if TIEN=""!(TIEN'?.N)
- QUIT
- Begin DoDot:1
- +6 IF $DATA(TEAM(TIEN))
- Begin DoDot:2
- +7 KILL XLIST
- +8 SET OKAY=$$TPTM^SCAPMC(TIEN,"","","","XLIST","ERROR")
- +9 SET SCTP=0
- FOR
- SET SCTP=$ORDER(XLIST("SCTP",TIEN,SCTP))
- if 'SCTP
- QUIT
- Begin DoDot:3
- +10 KILL YLIST
- SET SCDT="SCDT"
- SET (SCDT("BEGIN"),SCDT("END"))=DT
- SET SCDT("INCL")=0
- +11 SET OKAY=$$PRTP^SCAPMC(SCTP,.SCDT,"YLIST","ERROR",1,0)
- +12 SET SCI=0
- FOR
- SET SCI=$ORDER(YLIST(SCI))
- if 'SCI
- QUIT
- Begin DoDot:4
- +13 SET @TPRC@(0)=$GET(@TPRC@(0))+1
- +14 SET @TPRC@(@TPRC@(0))=YLIST(SCI)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +15 QUIT
- +16 ;
- TALL ;
- +1 ;get all active team for divisions selected
- +2 NEW NXT,IIEN,NODE
- +3 SET NXT=0
- SET IIEN=""
- +4 ;$O through team file and find all active teams for selected divisions
- +5 FOR
- SET IIEN=$ORDER(^SCTM(404.51,"AINST",IIEN))
- if IIEN=""
- QUIT
- Begin DoDot:1
- +6 IF INST=1!$DATA(INST(IIEN))
- Begin DoDot:2
- +7 SET TIEN=0
- +8 FOR
- SET TIEN=$ORDER(^SCTM(404.51,"AINST",IIEN,TIEN))
- if TIEN=""
- QUIT
- Begin DoDot:3
- +9 IF $$ACTTM^SCMCTMU(TIEN)
- SET TEAM(TIEN)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 QUIT
- +11 ;
- 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 IF '$DATA(@STORE@("PN",IIEN,PRAC,TIEN,TPI))
- SET @STORE@("PN",IIEN,PRAC,TIEN,TPI)="Practitioner: "_PNAME_$SELECT(SORT=3:"",1:" ("_POSN_")")
- +10 IF $LENGTH(PRCP)
- SET @STORE@("PN",IIEN,PRAC,TIEN,TPI,"PRCP")=" Preceptor: "_PRCP
- +11 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
- +12 ;
- +13 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)
- +14 SET @STORE@("T",IIEN,$SELECT($GET(SORT)=3:"T3",1:TNAME),$SELECT($GET(SORT)=3:1,1:TIEN))=""
- +15 IF '$DATA(@STORE@("P",IIEN,PNAME,PRAC,TPI))
- SET @STORE@("P",IIEN,PNAME,PRAC,TPI)=""
- +16 IF '$DATA(@STORE@("TOTAL",IIEN,PRAC,0))
- SET @STORE@("TOTAL",IIEN,PRAC,0)=0
- +17 IF '$DATA(@STORE@("TOTAL",IIEN,PRAC,TIEN))
- SET @STORE@("TOTAL",IIEN,PRAC,TIEN)=0
- +18 ;
- +19 SET @STORE@("TH",IIEN,PRAC)="Patient Count for "_PNAME_": "
- +20 SET @STORE@("TH",IIEN,PRAC,TIEN,TPI)="Patient Count for "_PNAME_": "
- +21 NEW SCX
- +22 SET SCX=$EXTRACT(PNAME,1,22)
- SET $EXTRACT(SCX,25)=$EXTRACT(POSN,1,22)
- SET $EXTRACT(SCX,49)=$EXTRACT(TNAME,1,22)
- +23 SET @STORE@("SUM0",IIEN,PRAC,TIEN,TPI)=SCX
- +24 ;
- +25 SET @STORE@("TH",IIEN)="** Note: Patient Panel Count is a count of unique patients for each practitioner"
- +26 QUIT 0