[613] | 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
|
---|