Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCRPTM2

SCRPTM2.m

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