| 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
|
|---|
