Index: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTM2.m
===================================================================
--- WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTM2.m	(revision 613)
+++ WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPTM2.m	(revision 623)
@@ -1,137 +1,128 @@
-SCRPTM2	;ALB/CMM - List of Team's Members Report Continued;01/29/96 ; 29 Jun 99  04:11PM
-	;;5.3;Scheduling;**41,140,177,520**;AUG 13, 1993;Build 26
-	;
-	;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))
-	.D SETASCL^SCRPRAC2(TPIEN,.PCLIN)
-	.S PCLIN=$G(PCLIN(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)
-	.N SCAC
-	.S SCAC=0
-	.F  S SCAC=$O(PCLIN(SCAC)) Q:SCAC=""  D FORMATAC(INS,TIEN,PRIEN,TPIEN,PCLIN(SCAC))
-	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
-	;
-FORMATAC(DIV,TEM,PIEN,TPIEN,PCLIN)	;
-	S $E(@STORE@(DIV,TEM,PIEN,TPIEN,4,SCAC),49)=$E(PCLIN,1,30)
-	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
+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
