Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTM2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTM2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTM2.m
r613 r623 1 SCRPTM2 ;ALB/CMM - List of Team's Members Report Continued;01/29/96 ; 29 Jun 99 04:11PM 2 ;;5.3;Scheduling;**41,140,177,520**;AUG 13, 1993;Build 26 3 ; 4 ;List of Team's Members Report 5 ; 6 PULL(TIEN,PLIST) ; 7 ;TIEN - team file ien 8 ;PLIST - array of positions and their practitioners 9 ; 10 N PNAME,TPIEN,ACT,INACT,RNAME,UNAME,CNT,NODE,TNODE,PCLIN,TNAME,SCI 11 N TPHONE,TPC,INS,INAME,PRIEN,PRNAME,OPH,ROOM,SERV,TPNODE,PRCP,PCLASS 12 ; 13 S CNT=0 14 F S CNT=$O(@PLIST@(CNT)) Q:CNT=""!(CNT'?.N) D 15 .;get each practitioner/position 16 .S NODE=$G(@PLIST@(CNT)) 17 .S TPIEN=+$P(NODE,"^",3) ;team position ien 18 .S PNAME=$P(NODE,"^",4) ;position name 19 .S ACT=$P(NODE,"^",9) ;active date (fm) 20 .I ACT'=""&(ACT'=0) S ACT=$TR($$FMTE^XLFDT(ACT,"5DF")," ","0") 21 .S INACT=$P(NODE,"^",10) ;inactive date (fm) 22 .I INACT'=""&(INACT'=0) S INACT=$TR($$FMTE^XLFDT(INACT,"5DF")," ","0") 23 .S RNAME=$P(NODE,"^",8) ;standard role name 24 .S UNAME=$P(NODE,"^",6) ;user class name 25 .S PRIEN=+$P(NODE,"^") ;practitioner ien 26 .S PRNAME=$P(NODE,"^",2) ;practitioner name 27 .; 28 .;Get person class information 29 .S PCLASS=$$GET^XUA4A72(PRIEN) 30 .F SCI=1,2,3 S PCLASS(SCI)=$P(PCLASS,U,(SCI+1)) 31 .; 32 .S TPNODE=$G(^SCTM(404.57,+TPIEN,0)) 33 .D SETASCL^SCRPRAC2(TPIEN,.PCLIN) 34 .S PCLIN=$G(PCLIN(0)) 35 .;S PCLIN=+$P(TPNODE,"^",9) ;associated clinic ien 36 .;S PCLIN=$P($G(^SC(PCLIN,0)),"^") ;associated clinic name 37 .; 38 .;Get preceptor 39 .S PRCP=$P($$OKPREC2^SCMCLK(TPIEN,DT),U,2) 40 .; 41 .S TNODE=$G(^SCTM(404.51,TIEN,0)) ;team node 42 .S TNAME=$P(TNODE,"^") ;team name 43 .S TPHONE=$P(TNODE,"^",2) ;team phone 44 .S TPC=$S($P(TNODE,"^",5)=1:"YES",1:"NO") ;primary care? 45 .S INS=+$P(TNODE,"^",7) ;team division ien 46 .S INAME=$P($G(^DIC(4,INS,0)),"^") ;team division name 47 .D KTEAM(TNAME,TPHONE,TPC,INAME,TIEN,INS) 48 .; 49 .S OPH=$P($G(^VA(200,PRIEN,.13)),"^",2) ;office phone 50 .S ROOM=$P($G(^VA(200,PRIEN,.14)),"^") ;room 51 .S SERV=+$P($G(^VA(200,PRIEN,5)),"^") ;service/section ien 52 .S SERV=$P($G(^DIC(49,SERV,0)),"^") ;service/section name 53 .; 54 .D FORMAT(PNAME,TPIEN,PCLIN,RNAME,UNAME,ACT,INACT,PRIEN,PRNAME,OPH,ROOM,SERV,INS,TIEN,PRCP,.PCLASS) 55 .N SCAC 56 .S SCAC=0 57 .F S SCAC=$O(PCLIN(SCAC)) Q:SCAC="" D FORMATAC(INS,TIEN,PRIEN,TPIEN,PCLIN(SCAC)) 58 Q 59 ; 60 KTEAM(TNAME,TPHONE,TPC,TDIV,TIEN,IEND) ; 61 ;store team information 62 I TDIV="" S TDIV="[BAD DATA]" 63 I TNAME="" S TNAME="[BDA DATA]" 64 S @STORE@("I",TDIV,IEND)="" 65 S @STORE@("T",IEND,TNAME,TIEN)="" 66 S @STORE@(IEND)="Division: "_TDIV 67 S @STORE@(IEND,TIEN,"H1")="Team Name: "_TNAME 68 S $E(@STORE@(IEND,TIEN,"H1"),40)="Team Phone: "_TPHONE 69 S @STORE@(IEND,TIEN,"H2")="Primary Care Team: "_TPC 70 S @STORE@(IEND,TIEN,"H3")="" 71 S @STORE@(IEND,TIEN,"H4")="Members:" 72 Q 73 ; 74 FORMAT(POS,TPIEN,PCLIN,SPOS,UCLASS,BEG,END,PIEN,PRACT,OPH,ROOM,SERV,DIV,TEM,PRCP,PCLASS) ; 75 ;POS - position name 76 ;TPIEN - position ien 77 ;PCLIN - associated clinic 78 ;SPOS - standard position 79 ;UCLASS - user class 80 ;BEG - begin date 81 ;END - end date 82 ;PIEN - ien of new person file 83 ;PRACT - practitioner name 84 ;OPH - office number 85 ;ROOM - room 86 ;SERV - service 87 ;DIV - ien of division 88 ;TEM - ien of team 89 ;PRCP - preceptor 90 ;PCLASS - person class 91 ; 92 N SCI 93 I PRACT="" S PRACT="[BAD DATA]" 94 S @STORE@("PN",DIV,TEM,PRACT,PIEN,TPIEN)="" 95 S @STORE@(DIV,TEM,PIEN,TPIEN,1)=PRACT 96 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,1),35)="Position: "_POS 97 S @STORE@(DIV,TEM,PIEN,TPIEN,2)="Standard Role: "_SPOS 98 S @STORE@(DIV,TEM,PIEN,TPIEN,3)="User Class: "_UCLASS 99 S @STORE@(DIV,TEM,PIEN,TPIEN,4)=SERV 100 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,4),35)="Assoc Clinic: "_PCLIN 101 S @STORE@(DIV,TEM,PIEN,TPIEN,5)="Office Phone: "_OPH 102 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,5),35)="Room: "_ROOM 103 S @STORE@(DIV,TEM,PIEN,TPIEN,6)="Begin Date: "_BEG 104 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,6),35)="End Date: "_END 105 S SCI=7 106 I $L(PRCP) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="Preceptor: "_PRCP,SCI=8 107 I $L(PCLASS(1)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="Person Class: "_PCLASS(1),SCI=SCI+1 108 I $L(PCLASS(2)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)=" "_PCLASS(2),SCI=SCI+1 109 I $L(PCLASS(3)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)=" "_PCLASS(3) 110 Q 111 ; 112 FORMATAC(DIV,TEM,PIEN,TPIEN,PCLIN) ; 113 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,4,SCAC),49)=$E(PCLIN,1,30) 114 Q 115 ; 116 NEWP(INST,TEM,TITL,PAGE,HEAD) ; 117 ;new page 118 D NEWP1^SCRPU3(.PAGE,TITL) 119 D HEAD1(INST,TEM,.HEAD) 120 Q 121 ; 122 HEAD1(INST,TEM,HEAD) ; 123 ;write headings 124 W !,$G(@STORE@(INST)) 125 N NXT 126 S NXT="H" 127 F S NXT=$O(@STORE@(INST,TEM,NXT)) Q:NXT'?1"H".E D 128 .W !,$G(@STORE@(INST,TEM,NXT)) 129 W ! ;extra line between MEMBERS and practitioner list 130 S HEAD=1 131 Q 132 HOLD1(PAGE,TITL,INST,TEM,HEAD) ; 133 ;device is home, reached end of page 134 D HOLD^SCRPU3(.PAGE,TITL) 135 I STOP Q 136 D HEAD1(INST,TEM,.HEAD) 137 Q 1 SCRPTM2 ;ALB/CMM - List of Team's Members Report Continued;01/29/96 ; 29 Jun 99 04:11PM 2 ;;5.3;Scheduling;**41,140,177**;AUG 13, 1993 3 ; 4 ;List of Team's Members Report 5 ; 6 PULL(TIEN,PLIST) ; 7 ;TIEN - team file ien 8 ;PLIST - array of positions and their practitioners 9 ; 10 N PNAME,TPIEN,ACT,INACT,RNAME,UNAME,CNT,NODE,TNODE,PCLIN,TNAME,SCI 11 N TPHONE,TPC,INS,INAME,PRIEN,PRNAME,OPH,ROOM,SERV,TPNODE,PRCP,PCLASS 12 ; 13 S CNT=0 14 F S CNT=$O(@PLIST@(CNT)) Q:CNT=""!(CNT'?.N) D 15 .;get each practitioner/position 16 .S NODE=$G(@PLIST@(CNT)) 17 .S TPIEN=+$P(NODE,"^",3) ;team position ien 18 .S PNAME=$P(NODE,"^",4) ;position name 19 .S ACT=$P(NODE,"^",9) ;active date (fm) 20 .I ACT'=""&(ACT'=0) S ACT=$TR($$FMTE^XLFDT(ACT,"5DF")," ","0") 21 .S INACT=$P(NODE,"^",10) ;inactive date (fm) 22 .I INACT'=""&(INACT'=0) S INACT=$TR($$FMTE^XLFDT(INACT,"5DF")," ","0") 23 .S RNAME=$P(NODE,"^",8) ;standard role name 24 .S UNAME=$P(NODE,"^",6) ;user class name 25 .S PRIEN=+$P(NODE,"^") ;practitioner ien 26 .S PRNAME=$P(NODE,"^",2) ;practitioner name 27 .; 28 .;Get person class information 29 .S PCLASS=$$GET^XUA4A72(PRIEN) 30 .F SCI=1,2,3 S PCLASS(SCI)=$P(PCLASS,U,(SCI+1)) 31 .; 32 .S TPNODE=$G(^SCTM(404.57,+TPIEN,0)) 33 .S PCLIN=+$P(TPNODE,"^",9) ;associated clinic ien 34 .S PCLIN=$P($G(^SC(PCLIN,0)),"^") ;associated clinic name 35 .; 36 .;Get preceptor 37 .S PRCP=$P($$OKPREC2^SCMCLK(TPIEN,DT),U,2) 38 .; 39 .S TNODE=$G(^SCTM(404.51,TIEN,0)) ;team node 40 .S TNAME=$P(TNODE,"^") ;team name 41 .S TPHONE=$P(TNODE,"^",2) ;team phone 42 .S TPC=$S($P(TNODE,"^",5)=1:"YES",1:"NO") ;primary care? 43 .S INS=+$P(TNODE,"^",7) ;team division ien 44 .S INAME=$P($G(^DIC(4,INS,0)),"^") ;team division name 45 .D KTEAM(TNAME,TPHONE,TPC,INAME,TIEN,INS) 46 .; 47 .S OPH=$P($G(^VA(200,PRIEN,.13)),"^",2) ;office phone 48 .S ROOM=$P($G(^VA(200,PRIEN,.14)),"^") ;room 49 .S SERV=+$P($G(^VA(200,PRIEN,5)),"^") ;service/section ien 50 .S SERV=$P($G(^DIC(49,SERV,0)),"^") ;service/section name 51 .; 52 .D FORMAT(PNAME,TPIEN,PCLIN,RNAME,UNAME,ACT,INACT,PRIEN,PRNAME,OPH,ROOM,SERV,INS,TIEN,PRCP,.PCLASS) 53 Q 54 ; 55 KTEAM(TNAME,TPHONE,TPC,TDIV,TIEN,IEND) ; 56 ;store team information 57 I TDIV="" S TDIV="[BAD DATA]" 58 I TNAME="" S TNAME="[BDA DATA]" 59 S @STORE@("I",TDIV,IEND)="" 60 S @STORE@("T",IEND,TNAME,TIEN)="" 61 S @STORE@(IEND)="Division: "_TDIV 62 S @STORE@(IEND,TIEN,"H1")="Team Name: "_TNAME 63 S $E(@STORE@(IEND,TIEN,"H1"),40)="Team Phone: "_TPHONE 64 S @STORE@(IEND,TIEN,"H2")="Primary Care Team: "_TPC 65 S @STORE@(IEND,TIEN,"H3")="" 66 S @STORE@(IEND,TIEN,"H4")="Members:" 67 Q 68 ; 69 FORMAT(POS,TPIEN,PCLIN,SPOS,UCLASS,BEG,END,PIEN,PRACT,OPH,ROOM,SERV,DIV,TEM,PRCP,PCLASS) ; 70 ;POS - position name 71 ;TPIEN - position ien 72 ;PCLIN - associated clinic 73 ;SPOS - standard position 74 ;UCLASS - user class 75 ;BEG - begin date 76 ;END - end date 77 ;PIEN - ien of new person file 78 ;PRACT - practitioner name 79 ;OPH - office number 80 ;ROOM - room 81 ;SERV - service 82 ;DIV - ien of division 83 ;TEM - ien of team 84 ;PRCP - preceptor 85 ;PCLASS - person class 86 ; 87 N SCI 88 I PRACT="" S PRACT="[BAD DATA]" 89 S @STORE@("PN",DIV,TEM,PRACT,PIEN,TPIEN)="" 90 S @STORE@(DIV,TEM,PIEN,TPIEN,1)=PRACT 91 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,1),35)="Position: "_POS 92 S @STORE@(DIV,TEM,PIEN,TPIEN,2)="Standard Role: "_SPOS 93 S @STORE@(DIV,TEM,PIEN,TPIEN,3)="User Class: "_UCLASS 94 S @STORE@(DIV,TEM,PIEN,TPIEN,4)=SERV 95 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,4),35)="Assoc Clinic: "_PCLIN 96 S @STORE@(DIV,TEM,PIEN,TPIEN,5)="Office Phone: "_OPH 97 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,5),35)="Room: "_ROOM 98 S @STORE@(DIV,TEM,PIEN,TPIEN,6)="Begin Date: "_BEG 99 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,6),35)="End Date: "_END 100 S SCI=7 101 I $L(PRCP) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="Preceptor: "_PRCP,SCI=8 102 I $L(PCLASS(1)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="Person Class: "_PCLASS(1),SCI=SCI+1 103 I $L(PCLASS(2)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)=" "_PCLASS(2),SCI=SCI+1 104 I $L(PCLASS(3)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)=" "_PCLASS(3) 105 Q 106 ; 107 NEWP(INST,TEM,TITL,PAGE,HEAD) ; 108 ;new page 109 D NEWP1^SCRPU3(.PAGE,TITL) 110 D HEAD1(INST,TEM,.HEAD) 111 Q 112 ; 113 HEAD1(INST,TEM,HEAD) ; 114 ;write headings 115 W !,$G(@STORE@(INST)) 116 N NXT 117 S NXT="H" 118 F S NXT=$O(@STORE@(INST,TEM,NXT)) Q:NXT'?1"H".E D 119 .W !,$G(@STORE@(INST,TEM,NXT)) 120 W ! ;extra line between MEMBERS and practitioner list 121 S HEAD=1 122 Q 123 HOLD1(PAGE,TITL,INST,TEM,HEAD) ; 124 ;device is home, reached end of page 125 D HOLD^SCRPU3(.PAGE,TITL) 126 I STOP Q 127 D HEAD1(INST,TEM,.HEAD) 128 Q
Note:
See TracChangeset
for help on using the changeset viewer.
