Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTP.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTP.m
r613 r623 1 SCRPTP ;ALB/CMM - List of Team's Patients ; 29 Jun 99 04:11PM 2 ;;5.3;Scheduling;**41,48,174,177,526,520**;AUG 13, 1993;Build 26 3 ; 4 PROMPTS ;Prompt for Institution, Team, Role, Patient Status and Print device 5 N QTIME,PRNT,VAUTD,VAUTT,VAUTR,VAUTPS,NUMBER 6 K SCUP 7 S QTIME="" 8 W ! D INST^SCRPU1 I Y=-1 G ERR 9 W ! K Y D PRMTT^SCRPU1 I '$D(VAUTT) G ERR 10 W ! K Y D ROLE^SCRPU1 I '$D(VAUTR) G ERR 11 W ! K Y D PTSTAT^SCRPU2 I '$D(VAUTPS) G ERR 12 W ! K Y S SORT=$$SORT2^SCRPU2() 13 I SORT<1 G ERR 14 W !!,"This report requires 132 column output!" 15 D QUE(.VAUTD,.VAUTT,.VAUTR,VAUTPS,SORT) Q 16 ; 17 QUE(INST,TEAM,ROLE,PSTAT,SORT,IOP,ZTDTH) ;queue report 18 ;INST - institutions selected (variable and array) 19 ;TEAM - teams selected (variable and array) 20 ;ROLE - roles selected (variable and array) 21 ;PSTAT - patient status - 1=all or OPT or AC 22 ;SORT - 1=d,t,ptname 2=d,t,Pt ID 3=d,t,pract,pt name 4=d,t,pract,Pt ID 23 N ZTSAVE,II 24 F II="INST","TEAM","ROLE","ROLE(","SORT","PSTAT","INST(","TEAM(" S ZTSAVE(II)="" 25 W ! D EN^XUTMDEVQ("QENTRY^SCRPTP","Team Patient Listing",.ZTSAVE) 26 Q 27 ; 28 ENTRY2(INST,TEAM,ROLE,PSTAT,SORT,IOP,ZTDTH) ;Second entry point for GUI to use 29 ;INST - institutions selected (variable and array) 30 ;TEAM - teams selected (variable and array) 31 ;ROLE - roles selected (variable and array) 32 ;PSTAT - patient status - 1=all or OPT or AC 33 ;SORT - 1=d,t,ptname 2=d,t,Pt ID 3=d,t,pract,pt name 4=d,t,pract,Pt ID 34 ;IOP - print device 35 ;ZTDTH - queue time (optional) 36 ; 37 ;validate parameters 38 I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$D(PSTAT)!'$D(SORT)!'$D(IOP)!(IOP="") Q 39 N NUMBER 40 S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^") 41 I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2) 42 I IOST?1"C-".E D QENTRY G RET 43 I ZTDTH="" S ZTDTH=$H 44 S ZTRTN="QENTRY^SCRPTP" 45 S ZTDESC="List of Team's Patients",ZTIO=IOP 46 N II 47 F II="INST","TEAM","ROLE","ROLE(","SORT","PSTAT","INST(","TEAM(","IOP" S ZTSAVE(II)="" 48 D ^%ZTLOAD 49 RET S NUMBER=0 50 I $D(ZTSK) S NUMBER=ZTSK 51 D EXIT1 52 Q NUMBER 53 ; 54 QENTRY ;driver entry point 55 S TITL="Team Patient Listing",STORE="^TMP("_$J_",""SCRPTP"")" 56 K @STORE 57 S @STORE=0 58 D FIND 59 I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL) 60 I '$D(NODATA) D PRINTIT^SCRPTP2(STORE,TITL) 61 D EXIT2 62 Q 63 ERR ; 64 EXIT1 ; 65 K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,SCUP 66 Q 67 EXIT2 ; 68 K @STORE 69 K STOP,STORE,TITL,IOP,TEAM,INST,ROLE,PSTAT,SORT,NODATA 70 Q 71 FIND ; 72 N TIEN,ERR,LIST,OKAY 73 I TEAM=1 D TALL^SCRPPAT3 ;gets all teams for all divisions selected 74 S TIEN="",LIST="^TMP("_$J_",""SCRPTP ARRAY"")",ERR="ERROR" 75 K @LIST,@ERR 76 F S TIEN=$O(TEAM(TIEN)) Q:TIEN="" D 77 .;TIEN - team ien 78 .S OKAY=$$PTTM^SCAPMC2(TIEN,"",LIST,ERR) 79 .; gets all patients for given team 80 .D HITS^SCRPTP3(LIST,TIEN) 81 .K @LIST,@ERR 82 K @LIST,@ERR 83 Q 84 TINF(TIEN) ;team information 85 ;TIEN - team ien 86 ;returns: institution ien ^ team name ^ primary care ^ team phone 87 N PC,PHONE,TNODE,TNAME 88 S TNODE=$G(^SCTM(404.51,TIEN,0)) 89 S TNAME=$P(TNODE,"^") ;team name 90 S PC=$S($P(TNODE,"^",5)=1:"YES",1:"NO") ;primary care team 91 S PHONE=$P(TNODE,"^",2) ;team phone 92 S INS=+$P(TNODE,"^",7) ;institution ien 93 D TDESC^SCRPITP2(TIEN,INS) ;gets team description 94 Q INS_"^"_TNAME_"^"_PC_"^"_PHONE 95 ; 96 PST(PTIEN,CLIEN) ; 97 ;PTIEN - patient ien 98 ;CLIEN - associated clinic ien 99 ;returns 1=selected patient status, 0=not selected patient status 100 ; 101 N EN,NXT,FOUND,ENODE 102 S EN="",(FOUND,NXT)=0 103 Q:'$D(^DPT(PTIEN,"DE","B",CLIEN)) FOUND 104 S EN=$O(^DPT(PTIEN,"DE","B",CLIEN,"")) 105 I EN=""&(PSTAT=1) S FOUND=1 Q FOUND 106 Q:EN=""!'$D(^DPT(PTIEN,"DE",EN,1)) FOUND 107 F S NXT=$O(^DPT(PTIEN,"DE",EN,1,NXT)) Q:(FOUND)!(NXT="")!(NXT'?.N) D 108 .;check if active enrollment 109 .S ENODE=$G(^DPT(PTIEN,"DE",EN,1,NXT,0)) 110 .I $P(ENODE,"^",3)'="",$P(ENODE,"^",3)<DT+1!$P(ENODE,"^")>DT Q ;not active enrollment 111 .; ^ discharge date ^ enrollment date 112 .Q:$P(ENODE,"^",2)'=$E(PSTAT,1)&(PSTAT'=1) ;not selected patient status 113 .S FOUND=1 114 Q FOUND 115 ; 116 FORMAT(INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,CNAME,PINF,ROLN,PCAP) ;Format column information 117 ;INS - Institution ien 118 ;TIEN - team ien 119 ;PTIEN - patient ien 120 ;PTNAME - patient name 121 ;PID - SSN 122 ;PIEN - practitioner ien 123 ;PNAME - practitioner name 124 ;CNAME - clinic name 125 ;LAST - last appointment 126 ;NEXT - next appointment 127 ;ROLN - role name 128 ;PCAP - PC? 129 ; 130 N SEC,TRD 131 I PNAME="" S PNAME="[BAD DATA]" 132 I PTNAME="" S PTNAME="[BAD DATA]" 133 I PID="" S PID="*********" 134 S @STORE@("P",INS,TIEN,PNAME,PIEN)="" ;practitioner 135 S @STORE@("PT",INS,TIEN,PTNAME,PTIEN)="" ;patient 136 S @STORE@("PID",INS,TIEN,PID,PTIEN)="" 137 I (SORT=1)!(SORT=2) S SEC=PTIEN,TRD=PIEN ;sort doesn't include practitioner 138 I (SORT=3)!(SORT=4) S SEC=PIEN,TRD=PTIEN ;sort includes practitioner 139 S @STORE@(INS,TIEN,SEC,TRD)=$E(PTNAME,1,15) ;patient name 140 S $E(@STORE@(INS,TIEN,SEC,TRD),18)=PID ;9 digit pid 141 S $E(@STORE@(INS,TIEN,SEC,TRD),32)=$E(PNAME,1,22) ;practitioner name 142 S $E(@STORE@(INS,TIEN,SEC,TRD),56)=$E($G(ROLN),1,22) ;role name 143 S $E(@STORE@(INS,TIEN,SEC,TRD),80)=$G(PCAP) ;PC? 144 S $E(@STORE@(INS,TIEN,SEC,TRD),85)=$P(PINF,"^",8) ;last appointment 145 S $E(@STORE@(INS,TIEN,SEC,TRD),97)=$P(PINF,"^",9) ;next appointment 146 S $E(@STORE@(INS,TIEN,SEC,TRD),109)=$E(CNAME,1,24) ;clinic name 147 Q 148 FORMATAC(SCCNT,CNAME,PINF,INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,ROLN,PCAP) ;Format MULTIPLES 149 ;INS - Institution ien 150 ;TIEN - team ien 151 ;PTIEN - patient ien 152 ;PTNAME - patient name 153 ;PID - last 4 PID - includes pseudo notation as 5th 154 ;PIEN - practitioner ien 155 ;PNAME - practitioner name 156 ;CNAME - clinic name 157 ;LAST - last appointment 158 ;NEXT - next appointment 159 ;ROLN - role name 160 ;PCAP - PC? 161 ; 162 N SEC,TRD 163 I PNAME="" S PNAME="[BAD DATA]" 164 I PTNAME="" S PTNAME="[BAD DATA]" 165 I PID="" S PID="****" 166 S @STORE@("P",INS,TIEN,PNAME,PIEN)="" ;practitioner 167 S @STORE@("PT",INS,TIEN,PTNAME,PTIEN)="" ;patient 168 S @STORE@("PID",INS,TIEN,PID,PTIEN)="" ;last 4 pid 169 N TRD 170 I (SORT=1)!(SORT=2) S SEC=PTIEN,TRD=PIEN ;sort doesn't include practitioner 171 I (SORT=3)!(SORT=4) S SEC=PIEN,TRD=PTIEN ;sort includes practitioner 172 I '$D(@STORE@(INS,TIEN,SEC,TRD,SCCNT)) D 173 .S $E(@STORE@(INS,TIEN,SEC,TRD,SCCNT),85)=$P(PINF,"^",8) ;last appointment 174 .S $E(@STORE@(INS,TIEN,SEC,TRD,SCCNT),97)=$P(PINF,"^",9) ;next appointment 175 .S $E(@STORE@(INS,TIEN,SEC,TRD,SCCNT),109)=$E(CNAME,1,24) ;clinic name 176 .Q 177 Q 1 SCRPTP ;ALB/CMM - List of Team's Patients ; 29 Jun 99 04:11PM 2 ;;5.3;Scheduling;**41,48,174,177**;AUG 13, 1993 3 ; 4 PROMPTS ;Prompt for Institution, Team, Role, Patient Status and Print device 5 N QTIME,PRNT,VAUTD,VAUTT,VAUTR,VAUTPS,NUMBER 6 K SCUP 7 S QTIME="" 8 W ! D INST^SCRPU1 I Y=-1 G ERR 9 W ! K Y D PRMTT^SCRPU1 I '$D(VAUTT) G ERR 10 W ! K Y D ROLE^SCRPU1 I '$D(VAUTR) G ERR 11 W ! K Y D PTSTAT^SCRPU2 I '$D(VAUTPS) G ERR 12 W ! K Y S SORT=$$SORT2^SCRPU2() 13 I SORT<1 G ERR 14 W !!,"This report requires 132 column output!" 15 D QUE(.VAUTD,.VAUTT,.VAUTR,VAUTPS,SORT) Q 16 ; 17 QUE(INST,TEAM,ROLE,PSTAT,SORT,IOP,ZTDTH) ;queue report 18 ;INST - institutions selected (variable and array) 19 ;TEAM - teams selected (variable and array) 20 ;ROLE - roles selected (variable and array) 21 ;PSTAT - patient status - 1=all or OPT or AC 22 ;SORT - 1=d,t,ptname 2=d,t,last 4 Pt ID 3=d,t,pract,pt name 4=d,t,pract,last 4 Pt ID 23 N ZTSAVE,II 24 F II="INST","TEAM","ROLE","ROLE(","SORT","PSTAT","INST(","TEAM(" S ZTSAVE(II)="" 25 W ! D EN^XUTMDEVQ("QENTRY^SCRPTP","Team Patient Listing",.ZTSAVE) 26 Q 27 ; 28 ENTRY2(INST,TEAM,ROLE,PSTAT,SORT,IOP,ZTDTH) ;Second entry point for GUI to use 29 ;INST - institutions selected (variable and array) 30 ;TEAM - teams selected (variable and array) 31 ;ROLE - roles selected (variable and array) 32 ;PSTAT - patient status - 1=all or OPT or AC 33 ;SORT - 1=d,t,ptname 2=d,t,last 4 Pt ID 3=d,t,pract,pt name 4=d,t,pract,last 4 Pt ID 34 ;IOP - print device 35 ;ZTDTH - queue time (optional) 36 ; 37 ;validate parameters 38 I '$D(INST)!'$D(TEAM)!'$D(ROLE)!'$D(PSTAT)!'$D(SORT)!'$D(IOP)!(IOP="") Q 39 N NUMBER 40 S IOST=$P(IOP,"^",2),IOP=$P(IOP,"^") 41 I IOP?1"Q;".E S IOP=$P(IOP,"Q;",2) 42 I IOST?1"C-".E D QENTRY G RET 43 I ZTDTH="" S ZTDTH=$H 44 S ZTRTN="QENTRY^SCRPTP" 45 S ZTDESC="List of Team's Patients",ZTIO=IOP 46 N II 47 F II="INST","TEAM","ROLE","ROLE(","SORT","PSTAT","INST(","TEAM(","IOP" S ZTSAVE(II)="" 48 D ^%ZTLOAD 49 RET S NUMBER=0 50 I $D(ZTSK) S NUMBER=ZTSK 51 D EXIT1 52 Q NUMBER 53 ; 54 QENTRY ;driver entry point 55 S TITL="Team Patient Listing",STORE="^TMP("_$J_",""SCRPTP"")" 56 K @STORE 57 S @STORE=0 58 D FIND 59 I $O(@STORE@(0))="" S NODATA=$$NODATA^SCRPU3(TITL) 60 I '$D(NODATA) D PRINTIT^SCRPTP2(STORE,TITL) 61 D EXIT2 62 Q 63 ERR ; 64 EXIT1 ; 65 K ZTDTH,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTSAVE,SCUP 66 Q 67 EXIT2 ; 68 K @STORE 69 K STOP,STORE,TITL,IOP,TEAM,INST,ROLE,PSTAT,SORT,NODATA 70 Q 71 FIND ; 72 N TIEN,ERR,LIST,OKAY 73 I TEAM=1 D TALL^SCRPPAT3 ;gets all teams for all divisions selected 74 S TIEN="",LIST="^TMP("_$J_",""SCRPTP ARRAY"")",ERR="ERROR" 75 K @LIST,@ERR 76 F S TIEN=$O(TEAM(TIEN)) Q:TIEN="" D 77 .;TIEN - team ien 78 .S OKAY=$$PTTM^SCAPMC2(TIEN,"",LIST,ERR) 79 .; gets all patients for given team 80 .D HITS^SCRPTP3(LIST,TIEN) 81 .K @LIST,@ERR 82 K @LIST,@ERR 83 Q 84 TINF(TIEN) ;team information 85 ;TIEN - team ien 86 ;returns: institution ien ^ team name ^ primary care ^ team phone 87 N PC,PHONE,TNODE,TNAME 88 S TNODE=$G(^SCTM(404.51,TIEN,0)) 89 S TNAME=$P(TNODE,"^") ;team name 90 S PC=$S($P(TNODE,"^",5)=1:"YES",1:"NO") ;primary care team 91 S PHONE=$P(TNODE,"^",2) ;team phone 92 S INS=+$P(TNODE,"^",7) ;institution ien 93 D TDESC^SCRPITP2(TIEN,INS) ;gets team description 94 Q INS_"^"_TNAME_"^"_PC_"^"_PHONE 95 ; 96 PST(PTIEN,CLIEN) ; 97 ;PTIEN - patient ien 98 ;CLIEN - associated clinic ien 99 ;returns 1=selected patient status, 0=not selected patient status 100 ; 101 N EN,NXT,FOUND,ENODE 102 S EN="",(FOUND,NXT)=0 103 Q:'$D(^DPT(PTIEN,"DE","B",CLIEN)) FOUND 104 S EN=$O(^DPT(PTIEN,"DE","B",CLIEN,"")) 105 I EN=""&(PSTAT=1) S FOUND=1 Q FOUND 106 Q:EN=""!'$D(^DPT(PTIEN,"DE",EN,1)) FOUND 107 F S NXT=$O(^DPT(PTIEN,"DE",EN,1,NXT)) Q:(FOUND)!(NXT="")!(NXT'?.N) D 108 .;check if active enrollment 109 .S ENODE=$G(^DPT(PTIEN,"DE",EN,1,NXT,0)) 110 .I $P(ENODE,"^",3)'="",$P(ENODE,"^",3)<DT+1!$P(ENODE,"^")>DT Q ;not active enrollment 111 .; ^ discharge date ^ enrollment date 112 .Q:$P(ENODE,"^",2)'=$E(PSTAT,1)&(PSTAT'=1) ;not selected patient status 113 .S FOUND=1 114 Q FOUND 115 ; 116 FORMAT(INS,TIEN,PTIEN,PTNAME,PID,PIEN,PNAME,CNAME,LAST,NEXT,ROLN,PCAP) ;Format column information 117 ;INS - Institution ien 118 ;TIEN - team ien 119 ;PTIEN - patient ien 120 ;PTNAME - patient name 121 ;PID - last 4 PID - includes pseudo notation as 5th 122 ;PIEN - practitioner ien 123 ;PNAME - practitioner name 124 ;CNAME - clinic name 125 ;LAST - last appointment 126 ;NEXT - next appointment 127 ;ROLN - role name 128 ;PCAP - PC? 129 ; 130 N SEC,TRD 131 I PNAME="" S PNAME="[BAD DATA]" 132 I PTNAME="" S PTNAME="[BAD DATA]" 133 I PID="" S PID="****" 134 S @STORE@("P",INS,TIEN,PNAME,PIEN)="" ;practitioner 135 S @STORE@("PT",INS,TIEN,PTNAME,PTIEN)="" ;patient 136 S @STORE@("PID",INS,TIEN,PID,PTIEN)="" ;last 4 pid 137 N TRD 138 I (SORT=1)!(SORT=2) S SEC=PTIEN,TRD=PIEN ;sort doesn't include practitioner 139 I (SORT=3)!(SORT=4) S SEC=PIEN,TRD=PTIEN ;sort includes practitioner 140 S @STORE@(INS,TIEN,SEC,TRD)=$E(PTNAME,1,22) ;patient name 141 S $E(@STORE@(INS,TIEN,SEC,TRD),25)=PID ;last 4 pid 142 S $E(@STORE@(INS,TIEN,SEC,TRD),32)=$E(PNAME,1,22) ;practitioner name 143 S $E(@STORE@(INS,TIEN,SEC,TRD),56)=$E($G(ROLN),1,22) ;role name 144 S $E(@STORE@(INS,TIEN,SEC,TRD),80)=$G(PCAP) ;PC? 145 S $E(@STORE@(INS,TIEN,SEC,TRD),85)=LAST ;last appointment 146 S $E(@STORE@(INS,TIEN,SEC,TRD),97)=NEXT ;next appointment 147 S $E(@STORE@(INS,TIEN,SEC,TRD),109)=$E(CNAME,1,24) ;clinic name 148 Q
Note:
See TracChangeset
for help on using the changeset viewer.
