source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTM2.m@ 1520

SCRPTM2 ;ALB/CMM - List of Team's Members Report Continued;01/29/96 ; 29 Jun 99  04:11PM
 ;;5.3;Scheduling;**41,140,177**;AUG 13, 1993
 ;
 ;List of Team's Members Report
 ;
PULL(TIEN,PLIST) ;
 ;TIEN - team file ien
 ;PLIST - array of positions and their practitioners
 ;
 N PNAME,TPIEN,ACT,INACT,RNAME,UNAME,CNT,NODE,TNODE,PCLIN,TNAME,SCI
 N TPHONE,TPC,INS,INAME,PRIEN,PRNAME,OPH,ROOM,SERV,TPNODE,PRCP,PCLASS
 ;
 S CNT=0
 F  S CNT=$O(@PLIST@(CNT)) Q:CNT=""!(CNT'?.N)  D
 .;get each practitioner/position
 .S NODE=$G(@PLIST@(CNT))
 .S TPIEN=+$P(NODE,"^",3) ;team position ien
 .S PNAME=$P(NODE,"^",4) ;position name
 .S ACT=$P(NODE,"^",9) ;active date (fm)
 .I ACT'=""&(ACT'=0) S ACT=$TR($$FMTE^XLFDT(ACT,"5DF")," ","0")
 .S INACT=$P(NODE,"^",10) ;inactive date (fm)
 .I INACT'=""&(INACT'=0) S INACT=$TR($$FMTE^XLFDT(INACT,"5DF")," ","0")
 .S RNAME=$P(NODE,"^",8) ;standard role name
 .S UNAME=$P(NODE,"^",6) ;user class name
 .S PRIEN=+$P(NODE,"^") ;practitioner ien
 .S PRNAME=$P(NODE,"^",2) ;practitioner name
 .;
 .;Get person class information
 .S PCLASS=$$GET^XUA4A72(PRIEN)
 .F SCI=1,2,3 S PCLASS(SCI)=$P(PCLASS,U,(SCI+1))
 .;
 .S TPNODE=$G(^SCTM(404.57,+TPIEN,0))
 .S PCLIN=+$P(TPNODE,"^",9) ;associated clinic ien
 .S PCLIN=$P($G(^SC(PCLIN,0)),"^") ;associated clinic name
 .;
 .;Get preceptor
 .S PRCP=$P($$OKPREC2^SCMCLK(TPIEN,DT),U,2)
 .;
 .S TNODE=$G(^SCTM(404.51,TIEN,0)) ;team node
 .S TNAME=$P(TNODE,"^") ;team name
 .S TPHONE=$P(TNODE,"^",2) ;team phone
 .S TPC=$S($P(TNODE,"^",5)=1:"YES",1:"NO") ;primary care?
 .S INS=+$P(TNODE,"^",7) ;team division ien
 .S INAME=$P($G(^DIC(4,INS,0)),"^") ;team division name
 .D KTEAM(TNAME,TPHONE,TPC,INAME,TIEN,INS)
 .;
 .S OPH=$P($G(^VA(200,PRIEN,.13)),"^",2) ;office phone
 .S ROOM=$P($G(^VA(200,PRIEN,.14)),"^") ;room
 .S SERV=+$P($G(^VA(200,PRIEN,5)),"^") ;service/section ien
 .S SERV=$P($G(^DIC(49,SERV,0)),"^") ;service/section name
 .;
 .D FORMAT(PNAME,TPIEN,PCLIN,RNAME,UNAME,ACT,INACT,PRIEN,PRNAME,OPH,ROOM,SERV,INS,TIEN,PRCP,.PCLASS)
 Q
 ;
KTEAM(TNAME,TPHONE,TPC,TDIV,TIEN,IEND) ;
 ;store team information
 I TDIV="" S TDIV="[BAD DATA]"
 I TNAME="" S TNAME="[BDA DATA]"
 S @STORE@("I",TDIV,IEND)=""
 S @STORE@("T",IEND,TNAME,TIEN)=""
 S @STORE@(IEND)="Division: "_TDIV
 S @STORE@(IEND,TIEN,"H1")="Team Name: "_TNAME
 S $E(@STORE@(IEND,TIEN,"H1"),40)="Team Phone: "_TPHONE
 S @STORE@(IEND,TIEN,"H2")="Primary Care Team: "_TPC
 S @STORE@(IEND,TIEN,"H3")=""
 S @STORE@(IEND,TIEN,"H4")="Members:"
 Q
 ;
FORMAT(POS,TPIEN,PCLIN,SPOS,UCLASS,BEG,END,PIEN,PRACT,OPH,ROOM,SERV,DIV,TEM,PRCP,PCLASS) ;
 ;POS - position name
 ;TPIEN - position ien
 ;PCLIN - associated clinic
 ;SPOS - standard  position
 ;UCLASS - user class
 ;BEG - begin date
 ;END - end date
 ;PIEN - ien of new person file
 ;PRACT - practitioner name
 ;OPH - office number
 ;ROOM - room
 ;SERV - service
 ;DIV - ien of division
 ;TEM - ien of team
 ;PRCP - preceptor
 ;PCLASS - person class
 ;
 N SCI
 I PRACT="" S PRACT="[BAD DATA]"
 S @STORE@("PN",DIV,TEM,PRACT,PIEN,TPIEN)=""
 S @STORE@(DIV,TEM,PIEN,TPIEN,1)=PRACT
 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,1),35)="Position: "_POS
 S @STORE@(DIV,TEM,PIEN,TPIEN,2)="Standard Role: "_SPOS
 S @STORE@(DIV,TEM,PIEN,TPIEN,3)="User Class: "_UCLASS
 S @STORE@(DIV,TEM,PIEN,TPIEN,4)=SERV
 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,4),35)="Assoc Clinic: "_PCLIN
 S @STORE@(DIV,TEM,PIEN,TPIEN,5)="Office Phone: "_OPH
 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,5),35)="Room: "_ROOM
 S @STORE@(DIV,TEM,PIEN,TPIEN,6)="Begin Date: "_BEG
 S $E(@STORE@(DIV,TEM,PIEN,TPIEN,6),35)="End Date: "_END
 S SCI=7
 I $L(PRCP) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="Preceptor: "_PRCP,SCI=8
 I $L(PCLASS(1)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="Person Class: "_PCLASS(1),SCI=SCI+1
 I $L(PCLASS(2)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="                 "_PCLASS(2),SCI=SCI+1
 I $L(PCLASS(3)) S @STORE@(DIV,TEM,PIEN,TPIEN,SCI)="                    "_PCLASS(3)
 Q
 ;
NEWP(INST,TEM,TITL,PAGE,HEAD) ;
 ;new page
 D NEWP1^SCRPU3(.PAGE,TITL)
 D HEAD1(INST,TEM,.HEAD)
 Q
 ;
HEAD1(INST,TEM,HEAD) ;
 ;write headings
 W !,$G(@STORE@(INST))
 N NXT
 S NXT="H"
 F  S NXT=$O(@STORE@(INST,TEM,NXT)) Q:NXT'?1"H".E  D
 .W !,$G(@STORE@(INST,TEM,NXT))
 W ! ;extra line between MEMBERS and practitioner list
 S HEAD=1
 Q
HOLD1(PAGE,TITL,INST,TEM,HEAD) ;
 ;device is home, reached end of page
 D HOLD^SCRPU3(.PAGE,TITL)
 I STOP Q
 D HEAD1(INST,TEM,.HEAD)
 Q