Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPEC2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPEC2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPEC2.m
r613 r623 1 SCRPEC2 2 ;;5.3;Scheduling;**41,140,174,177,526**;AUG 13, 1993;Build 8 3 4 5 6 PAT(TIEN,PTLIST) 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 KEEP(TIEN,PTIEN,CLLIST) 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 SETUP(INS,INAME,TIEN,TNAME,PTIEN,PNAME,CIEN,CNAME) 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 PCASSIGN(DFN,TIEN) 80 81 82 83 84 85 86 87 88 89 90 91 92 93 HEADER 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 S $E(@STORE@("SUBHEADER",HLD),16)="Pt ID"109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 FORMAT(PTIEN,INS,TIEN,PDATA,CNAME,CIEN) 124 125 126 127 128 129 130 131 S @STORE@(INS,TIEN,CIEN,PTIEN)=$E($P(PDATA,"^"),1,12) ;patient name132 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),14)=$P(PDATA,"^",2) ;primary long id 9 digit 133 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),26)=$P(PDATA,"^",3) ;means test category134 135 136 137 138 139 140 141 142 143 144 145 CHEAD(INS,TEAM,CLINIC) 146 147 148 149 150 151 152 153 154 155 CH2 156 157 1 SCRPEC2 ;ALB/CMM - Detail List of Pts & Enroll Clinics Continued ; 29 Jun 99 04:11PM 2 ;;5.3;Scheduling;**41,140,174,177**;AUG 13, 1993 3 ; 4 ;Detailed Listing of Patients and Their Enrolled Clinics Report 5 ; 6 PAT(TIEN,PTLIST) ; 7 ;TIEN - team ien 8 ;PTLIST - array holding patients assigned to team TIEN 9 ; 10 N PTIEN,ENT,NODE,OKAY,CLLIST,ERR,PC 11 S ENT=0,CLLIST="LIST2",ERR="ERROR2" 12 K @CLLIST 13 F S ENT=$O(@PTLIST@(ENT)) Q:ENT=""!(ENT'?.N) D 14 .S NODE=$G(@PTLIST@(ENT)) 15 .Q:NODE="" 16 .S PTIEN=+$P(NODE,"^") ;patient ien 17 .S PC=$$PCASSIGN(PTIEN,TIEN) 18 .Q:PC'=ASSUN ;not selected assigned/unassigned primary care 19 .K @CLLIST 20 .S OKAY=$$CLPT^SCAPMC29(PTIEN,"","",.CLLIST,.ERR) 21 .;all clinics for patient PTIEN 22 .Q:'OKAY 23 .D KEEP(TIEN,PTIEN,.CLLIST) 24 K @CLLIST 25 Q 26 ; 27 KEEP(TIEN,PTIEN,CLLIST) ;keep data for report 28 ;TIEN - team ien 29 ;PTIEN - patient ien 30 ;CLLIST - array holding clinics for patient PTIEN 31 ; 32 N ENT,TNAME,INS,NODE,INAME,PDATA,NODE,CIEN,CNAME,PNAME 33 N SCPCPR,SCPCAP,SCI,PCLIST 34 S TNAME=$P($G(^SCTM(404.51,TIEN,0)),"^") ;team name 35 S INS=+$P($G(^SCTM(404.51,TIEN,0)),"^",7) ;institution ien 36 S INAME=$P($G(^DIC(4,INS,0)),"^") ;institution name 37 S PNAME=$P($G(^DPT(PTIEN,0)),"^") ;patient name 38 K ^TMP("SC",$J,PTIEN) 39 S SCI=$$GETALL^SCAPMCA(PTIEN) D 40 .;Name of PC Provider 41 .S SCPCPR=$P($G(^TMP("SC",$J,PTIEN,"PCPR",1)),U,2) 42 .;Name of Associate Provider 43 .S SCPCAP=$P($G(^TMP("SC",$J,PTIEN,"PCAP",1)),U,2) 44 .Q 45 ; 46 S ENT=0 47 F S ENT=$O(@CLLIST@(ENT)) Q:ENT=""!(ENT'?.N) D 48 .S NODE=$G(@CLLIST@(ENT)) 49 .S CIEN=+$P(NODE,"^") ;clinic ien 50 .I CLINIC'=1,'$D(CLINIC(CIEN)) Q 51 .S CNAME=$P(NODE,"^",2) ;clinic name 52 .D SETUP(INS,INAME,TIEN,TNAME,PTIEN,PNAME,CIEN,CNAME) 53 .S PDATA=$$PDATA^SCRPEC(PTIEN,CIEN,1) 54 .S $P(PDATA,U,9)=SCPCPR,$P(PDATA,U,10)=SCPCAP 55 .;name^pid^mt^pelig^pstat^statd^last^next^pc prov.^assoc. prov. 56 .D FORMAT(PTIEN,INS,TIEN,PDATA,CNAME,CIEN) 57 Q 58 ; 59 SETUP(INS,INAME,TIEN,TNAME,PTIEN,PNAME,CIEN,CNAME) ; 60 ;INS - institution ien 61 ;INAME - institution name 62 ;TIEN - team ien 63 ;TNAME - team name 64 ;PTIEN - patient ien 65 ;PNAME - patient name 66 ;CIEN - clinic ien 67 ;CNAME - clinic name 68 ; 69 I INAME="" S INAME="[BAD DATA]" 70 I TNAME="" S TNAME="[BAD DATA]" 71 I CNAME="" S CNAME="[BAD DATA]" 72 I PNAME="" S PNAME="[BAD DATA]" 73 I '$D(@STORE@("I",INAME,INS)) S @STORE@("I",INAME,INS)="",@STORE@(INS)="Division: "_INAME 74 I '$D(@STORE@("T",INS,TNAME,TIEN)) S @STORE@("T",INS,TNAME,TIEN)="",@STORE@(INS,TIEN)="Team: "_TNAME 75 I '$D(@STORE@("C",INS,TIEN,CNAME,CIEN)) S @STORE@("C",INS,TIEN,CNAME,CIEN)="" ;D HEADER(INS,TIEN,CIEN) 76 I '$D(@STORE@("PT",INS,TIEN,CIEN,PNAME,PTIEN)) S @STORE@("PT",INS,TIEN,CIEN,PNAME,PTIEN)="" 77 Q 78 ; 79 PCASSIGN(DFN,TIEN) ;patient assigned to team as primary care 80 ;DFN - patient ien 81 ;TIEN - team ien 82 ;1 - yes 83 ;0 - no 84 ; 85 N ADATE,ENTRY,PC 86 S PC=0 87 I '$D(^SCPT(404.42,"AIDT",DFN,TIEN)) Q PC 88 S ADATE=$O(^SCPT(404.42,"AIDT",DFN,TIEN,"")) ; -team assignemtn date 89 S ENTRY=$O(^SCPT(404.42,"AIDT",DFN,TIEN,ADATE,"")) ;patient team assignemtn ien 90 I $P($G(^SCPT(404.42,+ENTRY,0)),"^",8)=1 S PC=1 91 Q PC 92 ; 93 HEADER ;report column titles 94 N HLD 95 S HLD="H0" 96 S $E(@STORE@("SUBHEADER",HLD),25)="M.T." 97 S $E(@STORE@("SUBHEADER",HLD),31)="Prim" 98 ;Removed by patch 174 99 ;S $E(@STORE@("SUBHEADER",HLD),31)="Pat" 100 ;S $E(@STORE@("SUBHEADER",HLD),36)="Status" 101 S $E(@STORE@("SUBHEADER",HLD),42)="Last" 102 S $E(@STORE@("SUBHEADER",HLD),54)="Next" 103 S $E(@STORE@("SUBHEADER",HLD),66)="Enrolled" 104 S $E(@STORE@("SUBHEADER",HLD),95)="Primary Care" 105 S $E(@STORE@("SUBHEADER",HLD),115)="Associate" 106 S HLD="H1" 107 S @STORE@("SUBHEADER",HLD)="Patient Name" 108 S $E(@STORE@("SUBHEADER",HLD),18)="Pt ID" 109 S $E(@STORE@("SUBHEADER",HLD),25)="Stat" 110 S $E(@STORE@("SUBHEADER",HLD),31)="Elig" 111 ;Removed by patch 174 112 ;S $E(@STORE@("SUBHEADER",HLD),31)="Stat" 113 ;S $E(@STORE@("SUBHEADER",HLD),36)="Date" 114 S $E(@STORE@("SUBHEADER",HLD),42)="Appt" 115 S $E(@STORE@("SUBHEADER",HLD),54)="Appt" 116 S $E(@STORE@("SUBHEADER",HLD),66)="Clinic" 117 S $E(@STORE@("SUBHEADER",HLD),95)="Provider" 118 S $E(@STORE@("SUBHEADER",HLD),115)="Provider" 119 S HLD="H2" 120 S $P(@STORE@("SUBHEADER",HLD),"=",133)="" 121 Q 122 ; 123 FORMAT(PTIEN,INS,TIEN,PDATA,CNAME,CIEN) ;format data for report 124 ;PTIEN - patient ien 125 ;INS - institution ien 126 ;TIEN - team ien 127 ;PDATA - pt name^pid^mt^pelig^pstat^statd^last^next^pc prov.^assoc. prov. 128 ;CNAME - clinic name 129 ;CIEN - clinic ien 130 ; 131 S @STORE@(INS,TIEN,CIEN,PTIEN)=$E($P(PDATA,"^"),1,15) ;patient name 132 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),18)=$E($P(PDATA,"^",2),6,10) ;primary long id last 4 plus P 133 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),25)=$P(PDATA,"^",3) ;means test category 134 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),31)=$P(PDATA,"^",4) ;primary eligibility 135 ;Removed by patch 174 136 ;S $E(@STORE@(INS,TIEN,CIEN,PTIEN),31)=$P(PDATA,"^",5) ;patient status 137 ;S $E(@STORE@(INS,TIEN,CIEN,PTIEN),35)=$P(PDATA,"^",6) ;status date 138 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),42)=$P(PDATA,"^",7) ;last appointment 139 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),54)=$P(PDATA,"^",8) ;next appointment 140 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),66)=$E(CNAME,1,27) ;clinic name 141 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),95)=$E($P(PDATA,U,9),1,18) ;PC prov. 142 S $E(@STORE@(INS,TIEN,CIEN,PTIEN),115)=$E($P(PDATA,U,10),1,18) ;Assoc. Prov. 143 Q 144 ; 145 CHEAD(INS,TEAM,CLINIC) ; 146 ;column headings 147 ; 148 N EN,NEWP 149 W ! 150 S NEWP=0 151 I IOST'?1"C-".E,$Y+5>(IOSL-6) D NEWP1^SCRPU3(.PAGE,TITL) S NEWP=1 152 I IOST?1"C-".E,$Y+5>(IOSL-6) D HOLD^SCRPU3(.PAGE,TITL) S NEWP=1 153 I STOP Q 154 I NEWP W !,$G(@STORE@(INS)),!!,$G(@STORE@(INS,TEAM)),! 155 CH2 F EN="H0","H1","H2" W !,$G(@STORE@("SUBHEADER",EN)) 156 Q 157 ;
Note:
See TracChangeset
for help on using the changeset viewer.
