Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPPAT3.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPPAT3.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPPAT3.m
r613 r623 1 SCRPPAT3 ;ALB/CMM - Practitioner's Patients ; 8/30/99 3:14pm 2 ;;5.3;Scheduling;**41,52,148,174,181,177,297,526,520**;AUG 13, 1993;Build 26 3 ; 4 ;Listing of Practitioner's Patients 5 ; 6 PAT(INS,SEC,TRD,SEC3,ST3,ST4,POS) ; 7 ;writes patients for position/practitioner 8 N PTN,PT,FIRST 9 S PTN="",FIRST=1 10 I SUMM D TOTAL1^SCRPPAT3(INS,SEC,TRD,POS) Q ;Summary only 11 F S PTN=$O(@STORE@("PT",INS,SEC,TRD,POS,PTN)) Q:PTN=""!(STOP) D 12 .S PT=0 13 .F S PT=$O(@STORE@("PT",INS,SEC,TRD,POS,PTN,PT)) Q:'PT!(STOP) D 14 ..I FIRST D HEADER S FIRST=0 15 ..W !,$G(@STORE@(INS,SEC,TRD,POS,PT)) ;print patient detail line 16 ..;I FIRST D HEADER S FIRST=0 17 ..N SCCN 18 ..S SCCN="" 19 ..F S SCCN=$O(@STORE@(INS,SEC,TRD,POS,PT,SCCN)) Q:SCCN="" D 20 ...W !,$G(@STORE@(INS,SEC,TRD,POS,PT,SCCN)) ;print patient detail line 21 ...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 22 ...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 23 ...Q:STOP 24 ...;I FIRST D HEADER S FIRST=0 25 ...Q 26 ..Q 27 .Q 28 Q 29 ; 30 SPRINT(STORE,IOP,TITL,SORT) ; Summary Print Only 31 ;STORE - global location of data 32 ;IOP - device to print to 33 ;TITL - title of report 34 ;SORT - sort order 1-div,team,pract/2-div,pract,team 35 ; 36 N PAGE 37 S PAGE=1,STOP=0 38 D OPEN^SCRPU3 39 Q:$G(POP) 40 D TITLE^SCRPU3(.PAGE,TITL) 41 D CLOSE^SCRPU3 42 Q 43 ; 44 TOTAL1(INS,SEC,TRD,POS) ; 45 ;print team/practitioner total 46 N TEM,PRC 47 I SORT=1 S TEM=SEC,PRC=TRD 48 I SORT=2!(SORT=3) S TEM=TRD,PRC=SEC 49 W !!,$G(@STORE@("TH",INS,PRC,TEM,POS)),$G(@STORE@("TOTAL",INS,PRC,TEM,POS)) 50 Q 51 ; 52 HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) ; 53 I (SEC3="""TN""")&($D(@ST4@(INS,TRD,SEC))) D 54 .W !,$G(@ST3@(INS,SEC)) ;write team (sort 1) 55 .W !,$G(@STORE@(INS)) 56 .W !,$G(@ST4@(INS,TRD,SEC,POS)) ;write practitioner (sort 2) 57 .I $L($G(@STORE@("PN",INS,TRD,SEC,POS,"PRCP"))) W !,@STORE@("PN",INS,TRD,SEC,POS,"PRCP") 58 .W ! 59 I (SEC3="""PN""")&($D(@ST3@(INS,SEC,TRD))) D 60 .W !,$G(@ST3@(INS,SEC,TRD,POS)) ;write practitioner (sort 1) 61 .I $G(SORT)'=3 I $L($G(@STORE@("PN",INS,SEC,TRD,POS,"PRCP"))) W !,@STORE@("PN",INS,SEC,TRD,POS,"PRCP") 62 .I $G(SORT)'=3 W !,$G(@ST4@(INS,TRD)) ;write team (sort 2) 63 .W !,$G(@STORE@(INS)) 64 Q 65 ; 66 HEADER ; 67 Q:$G(MORE) 68 I SORT=3 S MORE=1 69 N NXT 70 F NXT="H1","H2","H3" W !,$G(@STORE@(NXT)) 71 W ! 72 Q 73 ; 74 SHEAD ; 75 S @STORE@("H2")="Pt Name" 76 S $E(@STORE@("H2"),15)="Pt ID" 77 S $E(@STORE@("H1"),25)="M.T." 78 S $E(@STORE@("H2"),25)="Stat" 79 S $E(@STORE@("H1"),31)="Prim" 80 S $E(@STORE@("H2"),31)="Elig" 81 ;Removed by patch 174 82 ;S $E(@STORE@("H1"),39)="Pat" 83 ;S $E(@STORE@("H2"),39)="Stat" 84 S $E(@STORE@("H1"),42)="Last" 85 S $E(@STORE@("H2"),42)="Appt" 86 S $E(@STORE@("H1"),54)="Next" 87 S $E(@STORE@("H2"),54)="Appt" 88 S $E(@STORE@("H2"),66)="Clinic" 89 S $P(@STORE@("H3"),"=",81)="" 90 Q 91 ALL ; 92 ;get all practitioners for all teams selected 93 I TEAM=1 D TALL ;all teams selected 94 N TIEN,OKAY,XLIST,YLIST,SCTP,SCI,SCDT 95 S TIEN="" 96 F S TIEN=$O(TEAM(TIEN)) Q:TIEN=""!(TIEN'?.N) D 97 .I $D(TEAM(TIEN)) D 98 ..K XLIST 99 ..S OKAY=$$TPTM^SCAPMC(TIEN,"","","","XLIST","ERROR") 100 ..S SCTP=0 F S SCTP=$O(XLIST("SCTP",TIEN,SCTP)) Q:'SCTP D 101 ...K YLIST S SCDT="SCDT",(SCDT("BEGIN"),SCDT("END"))=DT,SCDT("INCL")=0 102 ...S OKAY=$$PRTP^SCAPMC(SCTP,.SCDT,"YLIST","ERROR",1,0) 103 ...S SCI=0 F S SCI=$O(YLIST(SCI)) Q:'SCI D 104 ....S @TPRC@(0)=$G(@TPRC@(0))+1 105 ....S @TPRC@(@TPRC@(0))=YLIST(SCI) 106 Q 107 ; 108 TALL ; 109 ;get all active team for divisions selected 110 N NXT,IIEN,NODE 111 S NXT=0,IIEN="" 112 ;$O through team file and find all active teams for selected divisions 113 F S IIEN=$O(^SCTM(404.51,"AINST",IIEN)) Q:IIEN="" D 114 .I INST=1!$D(INST(IIEN)) D 115 ..S TIEN=0 116 ..F S TIEN=$O(^SCTM(404.51,"AINST",IIEN,TIEN)) Q:TIEN="" D 117 ...I $$ACTTM^SCMCTMU(TIEN) S TEAM(TIEN)="" 118 Q 119 ; 120 SETUP(IIEN,INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; 121 ;setup data 122 S IIEN=+$P($G(^SCTM(404.51,TIEN,0)),"^",7) ;institution ien 123 S INAME=$P($G(^DIC(4,IIEN,0)),"^") ;institution name 124 I INAME="" S INAME="[BAD DATA]" 125 ; 126 I PNAME="" S PNAME="[BAD DATA]" 127 I TNAME="" S TNAME="[BAD DATA]" 128 I $G(SORT)=3 S IIEN=1,TIEN=1 129 I '$D(@STORE@("PN",IIEN,PRAC,TIEN,TPI)) S @STORE@("PN",IIEN,PRAC,TIEN,TPI)="Practitioner: "_PNAME_$S(SORT=3:"",1:" ("_POSN_")") 130 I $L(PRCP) S @STORE@("PN",IIEN,PRAC,TIEN,TPI,"PRCP")=" Preceptor: "_PRCP 131 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 132 ; 133 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) 134 S @STORE@("T",IIEN,$S($G(SORT)=3:"T3",1:TNAME),$S($G(SORT)=3:1,1:TIEN))="" 135 I '$D(@STORE@("P",IIEN,PNAME,PRAC,TPI)) S @STORE@("P",IIEN,PNAME,PRAC,TPI)="" 136 I '$D(@STORE@("TOTAL",IIEN,PRAC,0)) S @STORE@("TOTAL",IIEN,PRAC,0)=0 137 I '$D(@STORE@("TOTAL",IIEN,PRAC,TIEN)) S @STORE@("TOTAL",IIEN,PRAC,TIEN)=0 138 ; 139 S @STORE@("TH",IIEN,PRAC)="Patient Count for "_PNAME_": " 140 S @STORE@("TH",IIEN,PRAC,TIEN,TPI)="Patient Count for "_PNAME_": " 141 N SCX 142 S SCX=$E(PNAME,1,22),$E(SCX,25)=$E(POSN,1,22),$E(SCX,49)=$E(TNAME,1,22) 143 S @STORE@("SUM0",IIEN,PRAC,TIEN,TPI)=SCX 144 ; 145 S @STORE@("TH",IIEN)="** Note: Patient Panel Count is a count of unique patients for each practitioner" 146 Q 0 1 SCRPPAT3 ;ALB/CMM - Practitioner's Patients ; 8/30/99 3:14pm 2 ;;5.3;Scheduling;**41,52,148,174,181,177,297**;AUG 13, 1993 3 ; 4 ;Listing of Practitioner's Patients 5 ; 6 PAT(INS,SEC,TRD,SEC3,ST3,ST4,POS) ; 7 ;writes patients for position/practitioner 8 N PTN,PT,FIRST 9 S PTN="",FIRST=1 10 I SUMM D TOTAL1^SCRPPAT3(INS,SEC,TRD,POS) Q ;Summary only 11 F S PTN=$O(@STORE@("PT",INS,SEC,TRD,POS,PTN)) Q:PTN=""!(STOP) D 12 .S PT=0 13 .F S PT=$O(@STORE@("PT",INS,SEC,TRD,POS,PTN,PT)) Q:'PT!(STOP) D 14 ..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 15 ..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 16 ..Q:STOP 17 ..I FIRST D HEADER S FIRST=0 18 ..W !,$G(@STORE@(INS,SEC,TRD,POS,PT)) ;print patient detail line 19 ..Q 20 .Q 21 Q 22 ; 23 SPRINT(STORE,IOP,TITL,SORT) ; Summary Print Only 24 ;STORE - global location of data 25 ;IOP - device to print to 26 ;TITL - title of report 27 ;SORT - sort order 1-div,team,pract/2-div,pract,team 28 ; 29 N PAGE 30 S PAGE=1,STOP=0 31 D OPEN^SCRPU3 32 Q:$G(POP) 33 D TITLE^SCRPU3(.PAGE,TITL) 34 D CLOSE^SCRPU3 35 Q 36 ; 37 TOTAL1(INS,SEC,TRD,POS) ; 38 ;print team/practitioner total 39 N TEM,PRC 40 I SORT=1 S TEM=SEC,PRC=TRD 41 I SORT=2!(SORT=3) S TEM=TRD,PRC=SEC 42 W !!,$G(@STORE@("TH",INS,PRC,TEM,POS)),$G(@STORE@("TOTAL",INS,PRC,TEM,POS)) 43 Q 44 ; 45 HEAD2(INS,SEC,TRD,SEC3,ST3,ST4,POS) ; 46 I (SEC3="""TN""")&($D(@ST4@(INS,TRD,SEC))) D 47 .W !,$G(@ST3@(INS,SEC)) ;write team (sort 1) 48 .W !,$G(@STORE@(INS)) 49 .W !,$G(@ST4@(INS,TRD,SEC,POS)) ;write practitioner (sort 2) 50 .I $L($G(@STORE@("PN",INS,TRD,SEC,POS,"PRCP"))) W !,@STORE@("PN",INS,TRD,SEC,POS,"PRCP") 51 .W ! 52 I (SEC3="""PN""")&($D(@ST3@(INS,SEC,TRD))) D 53 .W !,$G(@ST3@(INS,SEC,TRD,POS)) ;write practitioner (sort 1) 54 .I $G(SORT)'=3 I $L($G(@STORE@("PN",INS,SEC,TRD,POS,"PRCP"))) W !,@STORE@("PN",INS,SEC,TRD,POS,"PRCP") 55 .I $G(SORT)'=3 W !,$G(@ST4@(INS,TRD)) ;write team (sort 2) 56 .W !,$G(@STORE@(INS)) 57 Q 58 ; 59 HEADER ; 60 Q:$G(MORE) 61 I SORT=3 S MORE=1 62 N NXT 63 F NXT="H1","H2","H3" W !,$G(@STORE@(NXT)) 64 W ! 65 Q 66 ; 67 SHEAD ; 68 S @STORE@("H2")="Pt Name" 69 S $E(@STORE@("H2"),18)="Pt ID" 70 S $E(@STORE@("H1"),25)="M.T." 71 S $E(@STORE@("H2"),25)="Stat" 72 S $E(@STORE@("H1"),31)="Prim" 73 S $E(@STORE@("H2"),31)="Elig" 74 ;Removed by patch 174 75 ;S $E(@STORE@("H1"),39)="Pat" 76 ;S $E(@STORE@("H2"),39)="Stat" 77 S $E(@STORE@("H1"),42)="Last" 78 S $E(@STORE@("H2"),42)="Appt" 79 S $E(@STORE@("H1"),54)="Next" 80 S $E(@STORE@("H2"),54)="Appt" 81 S $E(@STORE@("H2"),66)="Clinic" 82 S $P(@STORE@("H3"),"=",81)="" 83 Q 84 ALL ; 85 ;get all practitioners for all teams selected 86 I TEAM=1 D TALL ;all teams selected 87 N TIEN,OKAY,XLIST,YLIST,SCTP,SCI,SCDT 88 S TIEN="" 89 F S TIEN=$O(TEAM(TIEN)) Q:TIEN=""!(TIEN'?.N) D 90 .I $D(TEAM(TIEN)) D 91 ..K XLIST 92 ..S OKAY=$$TPTM^SCAPMC(TIEN,"","","","XLIST","ERROR") 93 ..S SCTP=0 F S SCTP=$O(XLIST("SCTP",TIEN,SCTP)) Q:'SCTP D 94 ...K YLIST S SCDT="SCDT",(SCDT("BEGIN"),SCDT("END"))=DT,SCDT("INCL")=0 95 ...S OKAY=$$PRTP^SCAPMC(SCTP,.SCDT,"YLIST","ERROR",1,0) 96 ...S SCI=0 F S SCI=$O(YLIST(SCI)) Q:'SCI D 97 ....S @TPRC@(0)=$G(@TPRC@(0))+1 98 ....S @TPRC@(@TPRC@(0))=YLIST(SCI) 99 Q 100 ; 101 TALL ; 102 ;get all active team for divisions selected 103 N NXT,IIEN,NODE 104 S NXT=0,IIEN="" 105 ;$O through team file and find all active teams for selected divisions 106 F S IIEN=$O(^SCTM(404.51,"AINST",IIEN)) Q:IIEN="" D 107 .I INST=1!$D(INST(IIEN)) D 108 ..S TIEN=0 109 ..F S TIEN=$O(^SCTM(404.51,"AINST",IIEN,TIEN)) Q:TIEN="" D 110 ...I $$ACTTM^SCMCTMU(TIEN) S TEAM(TIEN)="" 111 Q 112 ; 113 SETUP(IIEN,INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; 114 ;setup data 115 S IIEN=+$P($G(^SCTM(404.51,TIEN,0)),"^",7) ;institution ien 116 S INAME=$P($G(^DIC(4,IIEN,0)),"^") ;institution name 117 I INAME="" S INAME="[BAD DATA]" 118 ; 119 I PNAME="" S PNAME="[BAD DATA]" 120 I TNAME="" S TNAME="[BAD DATA]" 121 I $G(SORT)=3 S IIEN=1,TIEN=1 122 I '$D(@STORE@("PN",IIEN,PRAC,TIEN,TPI)) S @STORE@("PN",IIEN,PRAC,TIEN,TPI)="Practitioner: "_PNAME_$S(SORT=3:"",1:" ("_POSN_")") 123 I $L(PRCP) S @STORE@("PN",IIEN,PRAC,TIEN,TPI,"PRCP")=" Preceptor: "_PRCP 124 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 125 ; 126 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) 127 S @STORE@("T",IIEN,$S($G(SORT)=3:"T3",1:TNAME),$S($G(SORT)=3:1,1:TIEN))="" 128 I '$D(@STORE@("P",IIEN,PNAME,PRAC,TPI)) S @STORE@("P",IIEN,PNAME,PRAC,TPI)="" 129 I '$D(@STORE@("TOTAL",IIEN,PRAC,0)) S @STORE@("TOTAL",IIEN,PRAC,0)=0 130 I '$D(@STORE@("TOTAL",IIEN,PRAC,TIEN)) S @STORE@("TOTAL",IIEN,PRAC,TIEN)=0 131 ; 132 S @STORE@("TH",IIEN,PRAC)="Patient Count for "_PNAME_": " 133 S @STORE@("TH",IIEN,PRAC,TIEN,TPI)="Patient Count for "_PNAME_": " 134 N SCX 135 S SCX=$E(PNAME,1,22),$E(SCX,25)=$E(POSN,1,22),$E(SCX,49)=$E(TNAME,1,22) 136 S @STORE@("SUM0",IIEN,PRAC,TIEN,TPI)=SCX 137 ; 138 S @STORE@("TH",IIEN)="** Note: Patient Panel Count is a count of unique patients for each practitioner" 139 Q 0
Note:
See TracChangeset
for help on using the changeset viewer.
