Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPPAT2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPPAT2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPPAT2.m
r613 r623 1 SCRPPAT2 ;ALB/CMM - Practitioner's Patients ; 12/12/00 3:46pm 2 ;;5.3;Scheduling;**41,48,174,181,177,231,433,297,526,520**;AUG 13, 1993;Build 26 3 ; 4 ;Listing of Practitioner's Patients 5 ; 6 DRIVE ; 7 ;driver module 8 N PRAC,INF,ARRY,ERROR,NXT,OKAY,PIEN,TPRC 9 S ARRY="^TMP(""SCARRAY"","_$J_")",ERROR="ERR" 10 S TPRC="^TMP(""SCRP"",$J,""PRACT"")" M @TPRC=PRACT 11 K @ARRY,@ERROR,PRACT 12 I @TPRC=1 D ALL^SCRPPAT3 ;all practitioners selected 13 S NXT=0 14 F S NXT=$O(@TPRC@(NXT)) Q:NXT=""!(NXT'?.N) D 15 .I @TPRC=0 S PIEN=NXT 16 .I @TPRC=1 S PIEN=$P(@TPRC@(NXT),"^") 17 .K @ARRY,@ERROR 18 .S OKAY=$$PTPR^SCAPMC14(PIEN,"","","",ARRY,ERROR) ;patients for practitioner 19 .I '+OKAY Q 20 .D LOOPPT(ARRY,PIEN) ;loop through patients for practitioner 21 K @ARRY,@ERROR,@TPRC 22 K:SUMM @STORE@("PT") 23 Q 24 ; 25 LOOPPT(ARY,PRAC) ;loop through patients for practitioner 26 ;ARY - array of patients for selected practitioner 27 ;PRAC - practitioner ien 28 N NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,PTA,PTAN,TIEN 29 N PC,TNODE,TNAME,PINF,POSN,PRCP,CNAME 30 S NXT=0 31 F S NXT=$O(@ARY@(NXT)) Q:NXT=""!(NXT'?.N) D 32 .S NODE=$G(@ARY@(NXT)) 33 .Q:NODE="" 34 .S PIEN=+$P(NODE,"^") ;ien of patient file entry 35 .S TPIEN=+$P(NODE,"^",3) ;ien of patient team position assignment 36 .S PTP=$G(^SCPT(404.43,TPIEN,0)) 37 .Q:PTP="" 38 .S PTA=+$P(PTP,"^") ;patient team assignment ien (404.42) 39 .S PTAN=$G(^SCPT(404.42,PTA,0)) 40 .Q:PTAN="" 41 .S TIEN=+$P(PTAN,"^",3) ;team file ien (404.51) 42 .I $G(TEAM)'=1,'$D(TEAM(TIEN)) Q ;not a selected team 43 .S TNODE=$G(^SCTM(404.51,TIEN,0)) 44 .Q:TNODE="" I $G(INST)'=1,'$D(INST(+$P(TNODE,U,7))) Q 45 .S TNAME=$P(TNODE,"^") ;team name 46 .S TPI=+$P(PTP,"^",2) ;Team Position file ien (404.57) 47 .S TPN=$G(^SCTM(404.57,TPI,0)) 48 .Q:TPN="" 49 .I $G(ROLE)'=1,'$D(ROLE(+$P(TPN,U,3))) Q ;not a selected role 50 .S POSN=$P(TPN,"^") ;position name 51 .D SETASCL^SCRPRAC2(TPI,.CNAME,.CLIEN) ;get clinics from multiple 52 .;S CLIEN=+$P(TPN,"^",9) ;associated clinic ien 53 .;commented next line off - clinic enrollment no longer needed SD*5.3*433 54 .;D CECHK(CLIEN,.CNAME,PIEN) ;is patient enrolled in associated clinic? 55 .;S CNAME=$P($G(^SC(CLIEN,0)),"^") ; SD*5.3*433 remove enroll check 56 .S PC=$S($P(PTP,"^",5)=0:0,1:1) ;primary care position 1or2-yes/0-no 57 .S PNAME=$P($G(^VA(200,+PRAC,0)),"^") ;practitioner name 58 .Q:PNAME="" 59 .S PRCP=$P($$OKPREC2^SCMCLK(TPI,DT),U,2) 60 .D GETPINF(PIEN,.CLIEN,.PINF) ;get patient information and appointments 61 .S CNAME=$G(CNAME(0)) ;first line will capture position information 62 .S PINF=$G(PINF(0)) 63 .I PINF="" D 64 ..S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CNAME,CNAME,1) 65 .D FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) 66 .D SETFORM(PIEN,.CNAME,.PINF) 67 SETFORM(PIEN,CNAME,PINF) ;Format for clinic info only for multiples 68 N SCCNT 69 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) 70 Q 71 GETPINF(PIEN,CLIEN,PINF) ;get patient info 72 N SCCNT 73 S SCCNT="" F S SCCNT=$O(CLIEN(SCCNT)) Q:SCCNT="" D 74 .S PINF(SCCNT)=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN(SCCNT),CNAME(SCCNT),1) 75 Q 76 ; 77 CECHK(CLIEN,CNAME,PIEN) ;should no longer be used as of patch SD*5.3*433 78 ;CLIEN - clinic ien 79 ;CNAME - clinic name returned if patient is enrolled in clien clinic 80 ;PIEN - patien ien 81 ; 82 N EN,NODE 83 S CNAME="" 84 I $D(^DPT(PIEN,"DE","B",CLIEN)) D 85 .;enrolled at one time, check if discharged 86 .S EN=$O(^DPT(PIEN,"DE","B",CLIEN,"")) 87 .S NODE=$G(^DPT(PIEN,"DE",EN,0)) 88 .Q:NODE="" 89 .I $P(NODE,"^",3)="" S CNAME=$P($G(^SC(CLIEN,0)),"^") ;clinic name 90 .I $P(NODE,"^",3)'="",$P(NODE,"^",3)>DT S CNAME=$P($G(^SC(CLIEN,0)),"^") ;clinic name 91 Q 92 ; 93 FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display 94 ;CNAME - clinic name 95 ;PINF - patient/clinic data 96 ;PC - primary care 1/0 97 ;TIEN - team file ien (#404.51) 98 ;TNAME - team name 99 ;PRAC - practitioner ien (#200) 100 ;PNAME - practitioner name 101 ;POSN - position name 102 ;TPI - team position ien (#404.57) 103 ;PRCP - preceptor name 104 ; 105 N IIEN,INAME,ERR 106 S ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) 107 I ERR Q 108 ; 109 I SORT=1 D STOR(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI) ;sort division,team,practitioner 110 I SORT=2 D STOR(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI) ;sort division,practitioner,team 111 I SORT=3 D STOR(1,PRAC,1,PINF,PNAME,"T3",TPI) 112 Q 113 ; 114 FORMATAC(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display 115 ;CNAME - clinic name 116 ;PINF - patient/clinic data 117 ;PC - primary care 1/0 118 ;TIEN - team file ien (#404.51) 119 ;TNAME - team name 120 ;PRAC - practitioner ien (#200) 121 ;PNAME - practitioner name 122 ;POSN - position name 123 ;TPI - team position ien (#404.57) 124 ;PRCP - preceptor name 125 ; 126 N IIEN,INAME,ERR 127 S ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) 128 I ERR Q 129 ; 130 I SORT=1 D STORA(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,team,practitioner 131 I SORT=2 D STORA(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI,SCCNT) ;sort division,practitioner,team 132 I SORT=3 D STORA(1,PRAC,1,PINF,PNAME,"T3",TPI,SCCNT) 133 Q 134 ; 135 STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ; 136 ;IIEN - ien institution 137 ;SEC - second sort subscript, IEN team or IEN practitioner 138 ;TRD - third sort subscript, IEN team or IEN practitioner 139 ;PINF - patient/clinic info 140 ;PNAME - practitioner name 141 ;TNAME - team name 142 ;TPI - team position ien 143 ; 144 N PIEN,PTNAME,PID 145 S PIEN=+$P(PINF,"^") ;patient ien 146 S PTNAME=$E($P(PINF,"^",2),1,10) ;patient name 147 Q:$D(@STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)) 148 S @STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)="" 149 I 'SUMM,'$D(@STORE@("PTOT",IIEN,SEC,TRD,PIEN)) D 150 .;count each unique patient for any given practitioner for grand total 151 .S @STORE@("PTOT",IIEN,SEC,TRD,PIEN)="" 152 .S @STORE@("TOTAL",IIEN,PRAC,0)=$G(@STORE@("TOTAL",IIEN,PRAC,0))+1 ;patient count by practitioner 153 ; 154 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 155 Q:SUMM 156 ; 157 S @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME 158 S PID=$P(PINF,"^",3),PID=$TR(PID,"-","") 159 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),13)=PID ;ssn 160 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),25)=$P(PINF,"^",4) ;means test status 161 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),31)=$P(PINF,"^",5) ;eligibility 162 ;Removed by patch 174 163 ;S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),40)=$P(PINF,"^",6) ;patient status 164 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),42)=$P(PINF,"^",8) ;last appt 165 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),54)=$P(PINF,"^",9) ;nxt appt 166 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),66)=$E(CNAME,1,15) ;clinic 167 Q 168 STORA(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI,SCCNT) ; 169 I '$D(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT)) D 170 .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),42)=$P(PINF,"^",8) ;last appt 171 .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),54)=$P(PINF,"^",9) ;nxt appt 172 .S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN,SCCNT),66)=$E(CNAME,1,15) ;clinic 173 .Q 174 Q 1 SCRPPAT2 ;ALB/CMM - Practitioner's Patients ; 12/12/00 3:46pm 2 ;;5.3;Scheduling;**41,48,174,181,177,231,433,297**;AUG 13, 1993 3 ; 4 ;Listing of Practitioner's Patients 5 ; 6 DRIVE ; 7 ;driver module 8 N PRAC,INF,ARRY,ERROR,NXT,OKAY,PIEN,TPRC 9 S ARRY="^TMP(""SCARRAY"","_$J_")",ERROR="ERR" 10 S TPRC="^TMP(""SCRP"",$J,""PRACT"")" M @TPRC=PRACT 11 K @ARRY,@ERROR,PRACT 12 I @TPRC=1 D ALL^SCRPPAT3 ;all practitioners selected 13 S NXT=0 14 F S NXT=$O(@TPRC@(NXT)) Q:NXT=""!(NXT'?.N) D 15 .I @TPRC=0 S PIEN=NXT 16 .I @TPRC=1 S PIEN=$P(@TPRC@(NXT),"^") 17 .K @ARRY,@ERROR 18 .S OKAY=$$PTPR^SCAPMC14(PIEN,"","","",ARRY,ERROR) ;patients for practitioner 19 .I '+OKAY Q 20 .D LOOPPT(ARRY,PIEN) ;loop through patients for practitioner 21 K @ARRY,@ERROR,@TPRC 22 K:SUMM @STORE@("PT") 23 Q 24 ; 25 LOOPPT(ARY,PRAC) ;loop through patients for practitioner 26 ;ARY - array of patients for selected practitioner 27 ;PRAC - practitioner ien 28 N NXT,PIEN,TPIEN,PNAME,TPIEN,NODE,PTP,TPI,TPN,CLIEN,CNAME,PTA,PTAN,TIEN 29 N PC,TNODE,TNAME,PINF,POSN,PRCP 30 S NXT=0 31 F S NXT=$O(@ARY@(NXT)) Q:NXT=""!(NXT'?.N) D 32 .S NODE=$G(@ARY@(NXT)) 33 .Q:NODE="" 34 .S PIEN=+$P(NODE,"^") ;ien of patient file entry 35 .S TPIEN=+$P(NODE,"^",3) ;ien of patient team position assignment 36 .S PTP=$G(^SCPT(404.43,TPIEN,0)) 37 .Q:PTP="" 38 .S PTA=+$P(PTP,"^") ;patient team assignment ien (404.42) 39 .S PTAN=$G(^SCPT(404.42,PTA,0)) 40 .Q:PTAN="" 41 .S TIEN=+$P(PTAN,"^",3) ;team file ien (404.51) 42 .I $G(TEAM)'=1,'$D(TEAM(TIEN)) Q ;not a selected team 43 .S TNODE=$G(^SCTM(404.51,TIEN,0)) 44 .Q:TNODE="" I $G(INST)'=1,'$D(INST(+$P(TNODE,U,7))) Q 45 .S TNAME=$P(TNODE,"^") ;team name 46 .S TPI=+$P(PTP,"^",2) ;Team Position file ien (404.57) 47 .S TPN=$G(^SCTM(404.57,TPI,0)) 48 .Q:TPN="" 49 .I $G(ROLE)'=1,'$D(ROLE(+$P(TPN,U,3))) Q ;not a selected role 50 .S POSN=$P(TPN,"^") ;position name 51 .S CLIEN=+$P(TPN,"^",9) ;associated clinic ien 52 .;commented next line off - clinic enrollment no longer needed SD*5.3*433 53 .;D CECHK(CLIEN,.CNAME,PIEN) ;is patient enrolled in associated clinic? 54 .S CNAME=$P($G(^SC(CLIEN,0)),"^") ; SD*5.3*433 remove enroll check 55 .S PC=$S($P(PTP,"^",5)=0:0,1:1) ;primary care position 1or2-yes/0-no 56 .S PNAME=$P($G(^VA(200,+PRAC,0)),"^") ;practitioner name 57 .Q:PNAME="" 58 .S PRCP=$P($$OKPREC2^SCMCLK(TPI,DT),U,2) 59 .S PINF=PIEN_"^"_$$PDATA^SCRPEC(PIEN,CLIEN,1) 60 .;$$PDATA returns pt name,pid,mt,pelig,status,status date,last appt,nxt appt 61 .D FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ;formats data for display 62 Q 63 ; 64 CECHK(CLIEN,CNAME,PIEN) ; 65 ;CLIEN - clinic ien 66 ;CNAME - clinic name returned if patient is enrolled in clien clinic 67 ;PIEN - patien ien 68 ; 69 N EN,NODE 70 S CNAME="" 71 I $D(^DPT(PIEN,"DE","B",CLIEN)) D 72 .;enrolled at one time, check if discharged 73 .S EN=$O(^DPT(PIEN,"DE","B",CLIEN,"")) 74 .S NODE=$G(^DPT(PIEN,"DE",EN,0)) 75 .Q:NODE="" 76 .I $P(NODE,"^",3)="" S CNAME=$P($G(^SC(CLIEN,0)),"^") ;clinic name 77 .I $P(NODE,"^",3)'="",$P(NODE,"^",3)>DT S CNAME=$P($G(^SC(CLIEN,0)),"^") ;clinic name 78 Q 79 ; 80 FORMAT(CNAME,PINF,PC,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) ; format data for display 81 ;CNAME - clinic name 82 ;PINF - patient/clinic data 83 ;PC - primary care 1/0 84 ;TIEN - team file ien (#404.51) 85 ;TNAME - team name 86 ;PRAC - practitioner ien (#200) 87 ;PNAME - practitioner name 88 ;POSN - position name 89 ;TPI - team position ien (#404.57) 90 ;PRCP - preceptor name 91 ; 92 N IIEN,INAME,ERR 93 S ERR=$$SETUP^SCRPPAT3(.IIEN,.INAME,TIEN,TNAME,PRAC,PNAME,POSN,TPI,PRCP) 94 I ERR Q 95 ; 96 I SORT=1 D STOR(IIEN,TIEN,PRAC,PINF,PNAME,TNAME,TPI) ;sort division,team,practitioner 97 I SORT=2 D STOR(IIEN,PRAC,TIEN,PINF,PNAME,TNAME,TPI) ;sort division,practitioner,team 98 I SORT=3 D STOR(1,PRAC,1,PINF,PNAME,"T3",TPI) 99 Q 100 ; 101 STOR(IIEN,SEC,TRD,PINF,PNAME,TNAME,TPI) ; 102 ;IIEN - ien institution 103 ;SEC - second sort subscript, IEN team or IEN practitioner 104 ;TRD - third sort subscript, IEN team or IEN practitioner 105 ;PINF - patient/clinic info 106 ;PNAME - practitioner name 107 ;TNAME - team name 108 ;TPI - team position ien 109 ; 110 N PIEN,PTNAME,PID 111 S PIEN=+$P(PINF,"^") ;patient ien 112 S PTNAME=$E($P(PINF,"^",2),1,15) ;patient name 113 Q:$D(@STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)) 114 S @STORE@("PT",IIEN,SEC,TRD,TPI,PTNAME,PIEN)="" 115 ; 116 I 'SUMM,'$D(@STORE@("PTOT",IIEN,SEC,TRD,PIEN)) D 117 .;count each unique patient for any given practitioner for grand total 118 .S @STORE@("PTOT",IIEN,SEC,TRD,PIEN)="" 119 .S @STORE@("TOTAL",IIEN,PRAC,0)=$G(@STORE@("TOTAL",IIEN,PRAC,0))+1 ;patient count by practitioner 120 ; 121 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 122 Q:SUMM 123 ; 124 S @STORE@(IIEN,SEC,TRD,TPI,PIEN)=PTNAME 125 S PID=$P(PINF,"^",3),PID=$TR(PID,"-","") 126 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),18)=$E(PID,6,10) ;last 4 pid - 5 places is for any pseudo 127 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),25)=$P(PINF,"^",4) ;means test status 128 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),31)=$P(PINF,"^",5) ;eligibility 129 ;Removed by patch 174 130 ;S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),40)=$P(PINF,"^",6) ;patient status 131 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),42)=$P(PINF,"^",8) ;last appt 132 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),54)=$P(PINF,"^",9) ;nxt appt 133 S $E(@STORE@(IIEN,SEC,TRD,TPI,PIEN),66)=$E(CNAME,1,15) ;clinic 134 Q
Note:
See TracChangeset
for help on using the changeset viewer.
