Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTP2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTP2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTP2.m
r613 r623 1 SCRPTP2 ;ALB/CMM - List of Team's Patients ; 29 Jun 99 04:11PM 2 ;;5.3;Scheduling;**41,53,52,174,177,231,526,520**;AUG 13, 1993;Build 26 3 ; 4 ;List of Team's Patients Report 5 ; 6 TFORMAT(INST,INAME,TIEN,TNAME,PHONE,PC) ; Format team information 7 ;INST - institution ien 8 ;INAME - institution name 9 ;TIEN - team ien 10 ;TNAME - team name 11 ;PHONE - team phone 12 ;PC - primary care team (yes/no) 13 ; 14 I INAME="" S INAME="[BAD DATA]" 15 I TNAME="" S TNAME="[BAD DATA]" 16 S @STORE@("I",INAME,INST)="" 17 S @STORE@("T",INST,TNAME,TIEN)="" 18 S @STORE@(INST)="Division: "_INAME 19 S @STORE@(INST,TIEN)="Team: "_TNAME 20 S $E(@STORE@(INST,TIEN),45)="Team Phone: "_PHONE 21 S @STORE@(INST,TIEN,1)="Primary Care Team: "_PC 22 Q 23 ; 24 PRINTIT(STORE,TITL) ; 25 N INST,INAME,TNAME,TIEN 26 S (NEW,PAGE)=1,STOP=0 W:$E(IOST)="C" @IOF 27 D TITLE^SCRPU3(.PAGE,TITL,132) ;write title 28 D SETH 29 ; 30 S INAME="" 31 F S INAME=$O(@STORE@("I",INAME)) Q:INAME=""!(STOP) D 32 .S INST=$O(@STORE@("I",INAME,"")) 33 .Q:INST="" 34 .I ('NEW)&(IOST'?1"C-".E) D NEWP1^SCRPU3(.PAGE,TITL,132) 35 .I ('NEW)&(IOST?1"C-".E) D HOLD^SCRPU3(.PAGE,TITL,132) 36 .Q:STOP 37 .W !,$G(@STORE@(INST)) ;write institution 38 .S TNAME="" 39 .F S TNAME=$O(@STORE@("T",INST,TNAME)) Q:TNAME=""!(STOP) D 40 ..S TIEN=$O(@STORE@("T",INST,TNAME,"")) 41 ..Q:TIEN="" 42 ..D TPRINT(INST,TIEN) ;writes team info 43 ..Q:STOP 44 ..; 45 ..I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) 46 ..I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) 47 ..Q:STOP 48 ..D HEADER 49 ..I (SORT=3)!(SORT=4) D PRACT(INST,TIEN,.NEW) 50 ..I (SORT=1)!(SORT=2) D PTP(INST,TIEN,.NEW) 51 K NEW,PAGE 52 I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR 53 Q 54 ; 55 PRACT(INST,TIEN,NEW) ;Print by practitioner/patient 56 N PNAME,PIEN,SEC2,ST1,TRD,TRDI 57 S PNAME="",PIEN="" 58 F S PNAME=$O(@STORE@("P",INST,TIEN,PNAME)) Q:PNAME=""!(STOP) D 59 . F S PIEN=$O(@STORE@("P",INST,TIEN,PNAME,PIEN)) Q:PIEN=""!(STOP) D 60 . . I (SORT=1)!(SORT=3) S SEC2="""PT""" ;sort by patient name 61 . . I (SORT=2)!(SORT=4) S SEC2="""PID""" ;sort by last 4 PID 62 . . S ST1=$E(STORE,1,$L(STORE)-1)_","_SEC2_")" 63 . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 64 . . Q:STOP 65 . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 66 . . Q:STOP 67 . . S (TRDI,TRD)="" 68 . . F S TRD=$O(@ST1@(INST,TIEN,TRD)) Q:TRD=""!(STOP) D 69 . . . F S TRDI=$O(@ST1@(INST,TIEN,TRD,TRDI)) Q:TRDI=""!(STOP) D 70 . . . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 71 . . . . Q:STOP 72 . . . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 73 . . . . Q:STOP 74 . . . . I $D(@STORE@(INST,TIEN,PIEN,TRDI)) W !,$G(@STORE@(INST,TIEN,PIEN,TRDI)) ;write column data 75 . . . . N SCACL 76 . . . . S SCACL="" F S SCACL=$O(@STORE@(INST,TIEN,PIEN,TRDI,SCACL)) Q:SCACL="" D 77 . . . . . W !,$G(@STORE@(INST,TIEN,PIEN,TRDI,SCACL)) 78 . S NEW=0 79 Q 80 ; 81 PTP(INST,TIEN,NEW) ;Print by patient/practitioner 82 N SEC2,ST1,TRDI,TRD,PNAME,PIEN 83 I (SORT=1)!(SORT=3) S SEC2="""PT""" ;sort by patient name 84 I (SORT=2)!(SORT=4) S SEC2="""PID""" ;sort by last 4 PID 85 S ST1=$E(STORE,1,$L(STORE)-1)_","_SEC2_")" 86 I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) 87 I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) 88 Q:STOP 89 S (TRDI,TRD)="" 90 F S TRD=$O(@ST1@(INST,TIEN,TRD)) Q:TRD=""!(STOP) D 91 . F S TRDI=$O(@ST1@(INST,TIEN,TRD,TRDI)) Q:TRDI=""!(STOP) D 92 . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 93 . . Q:STOP 94 . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 95 . . Q:STOP 96 . . S PNAME="",PIEN="" 97 . . F S PNAME=$O(@STORE@("P",INST,TIEN,PNAME)) Q:PNAME=""!(STOP)!(PIEN=0) D 98 . . . F S PIEN=$O(@STORE@("P",INST,TIEN,PNAME,PIEN)) Q:PIEN=""!(STOP) D 99 . . . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 100 . . . . Q:STOP 101 . . . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 102 . . . . Q:STOP 103 . . . . I $D(@STORE@(INST,TIEN,TRDI,PIEN)) W !,$G(@STORE@(INST,TIEN,TRDI,PIEN)) ;write column data 104 . . . . N SCACL 105 . . . . S SCACL="" F S SCACL=$O(@STORE@(INST,TIEN,TRDI,PIEN,SCACL)) Q:SCACL="" D 106 . . . . . W !,$G(@STORE@(INST,TIEN,TRDI,PIEN,SCACL)) 107 . S NEW=0 108 Q 109 ; 110 TPRINT(INST,TIEN) ; 111 ;prints team data 112 N NXT 113 I (IOST'?1"C-".E)&($Y>(IOSL-13)) D NEWP1^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST)) 114 I (IOST?1"C-".E)&($Y>(IOSL-13)) D HOLD^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST)) 115 Q:STOP 116 W !!,$G(@STORE@(INST,TIEN)) 117 S NXT=0 118 W !,$G(@STORE@(INST,TIEN,1)) ;write team info 119 Q:'$D(@STORE@(INST,TIEN,"D")) W ! 120 S NXT="" 121 ;write team description 122 F S NXT=$O(@STORE@(INST,TIEN,"D",NXT)) Q:NXT=""!(STOP) D 123 .I (IOST'?1"C-".E)&$Y>(IOSL-13) D NEWP1^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST)) 124 .I (IOST?1"C-".E)&$Y>(IOSL-13) D HOLD^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST)) 125 .Q:STOP 126 .W !,$G(@STORE@(INST,TIEN,"D",NXT)) 127 W !!,"[Not Assigned] = Patient assigned to Team but not to a position/provider" 128 W !,"[Inactive Position] = Patient assigned to Team & Position but has no active provider" 129 Q 130 ; 131 HEADER ;prints column headings 132 N NXT 133 F NXT="H1","H2","H3" D 134 .W !,$G(@STORE@(NXT)) 135 Q 136 ; 137 SETH ;sets column headings 138 S @STORE@("H2")="Patient Name" 139 S $E(@STORE@("H2"),18)="Pt ID" 140 S $E(@STORE@("H2"),32)="Practitioner" 141 S $E(@STORE@("H2"),56)="Role" 142 S $E(@STORE@("H2"),80)="PC?" 143 S $E(@STORE@("H1"),85)="Last" 144 S $E(@STORE@("H2"),85)="Appt." 145 S $E(@STORE@("H1"),97)="Next" 146 S $E(@STORE@("H2"),97)="Appt." 147 S $E(@STORE@("H2"),109)="Associated Clinic" 148 S $P(@STORE@("H3"),"=",133)="" 149 Q 1 SCRPTP2 ;ALB/CMM - List of Team's Patients ; 29 Jun 99 04:11PM 2 ;;5.3;Scheduling;**41,53,52,174,177,231**;AUG 13, 1993 3 ; 4 ;List of Team's Patients Report 5 ; 6 TFORMAT(INST,INAME,TIEN,TNAME,PHONE,PC) ; Format team information 7 ;INST - institution ien 8 ;INAME - institution name 9 ;TIEN - team ien 10 ;TNAME - team name 11 ;PHONE - team phone 12 ;PC - primary care team (yes/no) 13 ; 14 I INAME="" S INAME="[BAD DATA]" 15 I TNAME="" S TNAME="[BAD DATA]" 16 S @STORE@("I",INAME,INST)="" 17 S @STORE@("T",INST,TNAME,TIEN)="" 18 S @STORE@(INST)="Division: "_INAME 19 S @STORE@(INST,TIEN)="Team: "_TNAME 20 S $E(@STORE@(INST,TIEN),45)="Team Phone: "_PHONE 21 S @STORE@(INST,TIEN,1)="Primary Care Team: "_PC 22 Q 23 ; 24 PRINTIT(STORE,TITL) ; 25 N INST,INAME,TNAME,TIEN 26 S (NEW,PAGE)=1,STOP=0 W:$E(IOST)="C" @IOF 27 D TITLE^SCRPU3(.PAGE,TITL,132) ;write title 28 D SETH 29 ; 30 S INAME="" 31 F S INAME=$O(@STORE@("I",INAME)) Q:INAME=""!(STOP) D 32 .S INST=$O(@STORE@("I",INAME,"")) 33 .Q:INST="" 34 .I ('NEW)&(IOST'?1"C-".E) D NEWP1^SCRPU3(.PAGE,TITL,132) 35 .I ('NEW)&(IOST?1"C-".E) D HOLD^SCRPU3(.PAGE,TITL,132) 36 .Q:STOP 37 .W !,$G(@STORE@(INST)) ;write institution 38 .S TNAME="" 39 .F S TNAME=$O(@STORE@("T",INST,TNAME)) Q:TNAME=""!(STOP) D 40 ..S TIEN=$O(@STORE@("T",INST,TNAME,"")) 41 ..Q:TIEN="" 42 ..D TPRINT(INST,TIEN) ;writes team info 43 ..Q:STOP 44 ..; 45 ..I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) 46 ..I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) 47 ..Q:STOP 48 ..D HEADER 49 ..I (SORT=3)!(SORT=4) D PRACT(INST,TIEN,.NEW) 50 ..I (SORT=1)!(SORT=2) D PTP(INST,TIEN,.NEW) 51 K NEW,PAGE 52 I 'STOP,$E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR 53 Q 54 ; 55 PRACT(INST,TIEN,NEW) ;Print by practitioner/patient 56 N PNAME,PIEN,SEC2,ST1,TRD,TRDI 57 S PNAME="",PIEN="" 58 F S PNAME=$O(@STORE@("P",INST,TIEN,PNAME)) Q:PNAME=""!(STOP) D 59 . F S PIEN=$O(@STORE@("P",INST,TIEN,PNAME,PIEN)) Q:PIEN=""!(STOP) D 60 . . I (SORT=1)!(SORT=3) S SEC2="""PT""" ;sort by patient name 61 . . I (SORT=2)!(SORT=4) S SEC2="""PID""" ;sort by last 4 PID 62 . . S ST1=$E(STORE,1,$L(STORE)-1)_","_SEC2_")" 63 . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 64 . . Q:STOP 65 . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 66 . . Q:STOP 67 . . S (TRDI,TRD)="" 68 . . F S TRD=$O(@ST1@(INST,TIEN,TRD)) Q:TRD=""!(STOP) D 69 . . . F S TRDI=$O(@ST1@(INST,TIEN,TRD,TRDI)) Q:TRDI=""!(STOP) D 70 . . . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 71 . . . . Q:STOP 72 . . . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 73 . . . . Q:STOP 74 . . . . I $D(@STORE@(INST,TIEN,PIEN,TRDI)) W !,$G(@STORE@(INST,TIEN,PIEN,TRDI)) ;write column data 75 . S NEW=0 76 Q 77 ; 78 PTP(INST,TIEN,NEW) ;Print by patient/practitioner 79 N SEC2,ST1,TRDI,TRD,PNAME,PIEN 80 I (SORT=1)!(SORT=3) S SEC2="""PT""" ;sort by patient name 81 I (SORT=2)!(SORT=4) S SEC2="""PID""" ;sort by last 4 PID 82 S ST1=$E(STORE,1,$L(STORE)-1)_","_SEC2_")" 83 I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) 84 I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) 85 Q:STOP 86 S (TRDI,TRD)="" 87 F S TRD=$O(@ST1@(INST,TIEN,TRD)) Q:TRD=""!(STOP) D 88 . F S TRDI=$O(@ST1@(INST,TIEN,TRD,TRDI)) Q:TRDI=""!(STOP) D 89 . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 90 . . Q:STOP 91 . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 92 . . Q:STOP 93 . . S PNAME="",PIEN="" 94 . . F S PNAME=$O(@STORE@("P",INST,TIEN,PNAME)) Q:PNAME=""!(STOP)!(PIEN=0) D 95 . . . F S PIEN=$O(@STORE@("P",INST,TIEN,PNAME,PIEN)) Q:PIEN=""!(STOP) D 96 . . . . I (IOST'?1"C-".E)&($Y>(IOSL-4)) D NEWP1^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 97 . . . . Q:STOP 98 . . . . I (IOST?1"C-".E)&($Y>(IOSL-4)) D HOLD^SCRPU3(.PAGE,TITL,132) D:'STOP HEADER 99 . . . . Q:STOP 100 . . . . I $D(@STORE@(INST,TIEN,TRDI,PIEN)) W !,$G(@STORE@(INST,TIEN,TRDI,PIEN)) ;write column data 101 . S NEW=0 102 Q 103 ; 104 TPRINT(INST,TIEN) ; 105 ;prints team data 106 N NXT 107 I (IOST'?1"C-".E)&($Y>(IOSL-13)) D NEWP1^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST)) 108 I (IOST?1"C-".E)&($Y>(IOSL-13)) D HOLD^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST)) 109 Q:STOP 110 W !!,$G(@STORE@(INST,TIEN)) 111 S NXT=0 112 W !,$G(@STORE@(INST,TIEN,1)) ;write team info 113 Q:'$D(@STORE@(INST,TIEN,"D")) W ! 114 S NXT="" 115 ;write team description 116 F S NXT=$O(@STORE@(INST,TIEN,"D",NXT)) Q:NXT=""!(STOP) D 117 .I (IOST'?1"C-".E)&$Y>(IOSL-13) D NEWP1^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST)) 118 .I (IOST?1"C-".E)&$Y>(IOSL-13) D HOLD^SCRPU3(.PAGE,TITL,132) W:'STOP !,$G(@STORE@(INST)) 119 .Q:STOP 120 .W !,$G(@STORE@(INST,TIEN,"D",NXT)) 121 W !!,"[Not Assigned] = Patient assigned to Team but not to a position/provider" 122 W !,"[Inactive Position] = Patient assigned to Team & Position but has no active provider" 123 Q 124 ; 125 HEADER ;prints column headings 126 N NXT 127 F NXT="H1","H2","H3" D 128 .W !,$G(@STORE@(NXT)) 129 Q 130 ; 131 SETH ;sets column headings 132 S @STORE@("H2")="Patient Name" 133 S $E(@STORE@("H2"),25)="Pt ID" 134 S $E(@STORE@("H2"),32)="Practitioner" 135 S $E(@STORE@("H2"),56)="Role" 136 S $E(@STORE@("H2"),80)="PC?" 137 S $E(@STORE@("H1"),85)="Last" 138 S $E(@STORE@("H2"),85)="Appt." 139 S $E(@STORE@("H1"),97)="Next" 140 S $E(@STORE@("H2"),97)="Appt." 141 S $E(@STORE@("H2"),109)="Associated Clinic" 142 S $P(@STORE@("H3"),"=",133)="" 143 Q
Note:
See TracChangeset
for help on using the changeset viewer.
