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

SCRPITP2.m

Go to the documentation of this file. 
  1. SCRPITP2 ;ALB/CMM - Individual Team Profile Continued ;7/25/99  18:24
  1.  ;;5.3;Scheduling;**41,177,520,1015**;AUG 13, 1993;Build 21
  1.  ;
  1.  ;Individual Team Profile
  1.  ;
  1. KEEP(TNODE,TPOS,TM,SCEN) ;
  1.  ;TNODE - zero node of the team position file entry TPOS
  1.  ;TPOS - ien of team position file entry TNODE
  1.  ;TM - ien of team
  1.  ;
  1.  N POS,PPC,CLIEN,PCLIN,MAX,ROL,CIEN,DIV
  1.  N SCRDATE,SCI,PROVLIST,SCPROV,SCPTASS,ERR
  1.  ;
  1.  D TEAM(TM,.DIV)
  1.  ;
  1.  S POS=$P(TNODE,"^") ;position name
  1.  S ROL=$P($G(^SD(403.46,+$P(TNODE,"^",3),0)),"^") ;standard position
  1.  S PPC=$S($P(TNODE,"^",4)'=1:"NPC",+$$OKPREC3^SCMCLK(TPOS,DT)>0:" AP",1:"PCP") ;primary care position
  1.  S MAX=$P(TNODE,"^",8)
  1.  ;
  1.  S SCRDATE="SCRDATE",(SCRDATE("BEGIN"),SCRDATE("END"))=DT,SCRDATE("INCL")=0
  1.  S SCI="PROVLIST",SCI=$$PRTP^SCAPMC(TPOS,.SCRDATE,SCI,"ERR",1,0)
  1.  S SCPROV=$P($G(PROVLIST(1)),U,2)
  1.  S SCPTASS=$$PCPOSCNT^SCAPMCU1(TPOS,DT,0)
  1.  ;
  1.  ;D FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,SCPROV,SCPTASS)
  1.  ;
  1.  D SETASCL^SCRPRAC2(TPOS,.CNAME,.CLIEN)
  1.  S CNAME=$G(CNAME(0))
  1.  ;S CIEN=+$P(TNODE,"^",9) ;clinic ien ;USING MULTIPLE WITH SD*5.3*520
  1.  ;S PCLIN=""
  1.  ;I CIEN>0 S PCLIN=$P($G(^SC(CIEN,0)),"^") ;associated clinic
  1.  ;
  1.  D FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,CNAME,SCPROV,SCPTASS)
  1.  N AC
  1.  S AC=0
  1.  F  S AC=$O(CNAME(AC)) Q:AC=""  D FORMATAC(POS,DIV,TM,TPOS,CNAME(AC))
  1.  K CNAME
  1.  Q
  1.  ;
  1. TEAM(TM,DIV) ;
  1.  ;
  1.  N TMN,TNAME,TDIV,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR
  1.  S TMN=$G(^SCTM(404.51,TM,0)) ;zero node of team file
  1.  S TNAME=$P(TMN,"^") ;team name
  1.  S DIV=+$P(TMN,"^",7) ;division ien
  1.  S TDIV=$P($G(^DIC(4,DIV,0)),"^") ;team division
  1.  S TPHONE=$P(TMN,"^",2) ;team phone
  1.  S TPC=+$P(TMN,"^",5) ;Primary Care Team ien
  1.  S TSERV=$P($G(^DIC(49,+$P(TMN,"^",6),0)),"^") ;Service/section
  1.  S STAT=$S(+$$ACTTM^SCMCTMU(TM)=1:"ACTIVE",1:"INACTIVE") ;Team status
  1.  S PUR=$P($G(^SD(403.47,+$P(TMN,"^",3),0)),"^")
  1.  S MAX=$P(TMN,"^",8)
  1.  S CUR=$$TEAMCNT^SCAPMCU1(TM,DT)
  1.  D TFORMAT(TNAME,DIV,TDIV,TM,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR)
  1.  ;
  1.  ;GET TEAM DESCRIPTION (WORD PROCESSING FIELD)
  1.  D TDESC(TM,DIV)
  1.  Q
  1. TDESC(TEM,DIV) ;
  1.  ;gets team description - word processing field
  1.  Q:'$O(^SCTM(404.51,TEM,"D",0))
  1.  N EN
  1.  S EN=0
  1.  S @STORE@(DIV,TEM,"D",0)="Team Description: "
  1.  S @STORE@(DIV,TEM,"D",.5)=""
  1.  F  S EN=$O(^SCTM(404.51,TEM,"D",EN)) Q:EN=""  D
  1.  .S @STORE@(DIV,TEM,"D",EN)=$G(^SCTM(404.51,TEM,"D",EN,0))
  1.  Q
  1.  ;
  1. TFORMAT(TNAME,DIV,TDIV,TM,TPHONE,TPC,TSERV,STAT,PUR,MAX,CUR) ;
  1.  ;
  1.  I TNAME="" S TNAME="[BAD DATA]"
  1.  I TDIV="" S TDIV="[BAD DATA]"
  1.  S @STORE@("I",TDIV,DIV)=""
  1.  S @STORE@("T",DIV,TNAME,TM)=""
  1.  S @STORE@(DIV)="Division: "_TDIV
  1.  ;
  1.  S @STORE@(DIV,TM,"TI",1)="Team Name: "_TNAME
  1.  S $E(@STORE@(DIV,TM,"TI",1),44)="Service/Section: "_$E(TSERV,1,30)
  1.  S $E(@STORE@(DIV,TM,"TI",1),(120-$L(TPHONE)))="Team Phone: "_TPHONE
  1.  S @STORE@(DIV,TM,"TI",2)=""
  1.  S @STORE@(DIV,TM,"TI",3)="Team Settings:"
  1.  S @STORE@(DIV,TM,"TI",4)=""
  1.  S @STORE@(DIV,TM,"TI",5)="Status: "_STAT
  1.  S $E(@STORE@(DIV,TM,"TI",5),19)="Maximum Patients: "_MAX
  1.  S $E(@STORE@(DIV,TM,"TI",5),47)="Unique Patients Assigned: "_CUR
  1.  S $E(@STORE@(DIV,TM,"TI",5),83)="Purpose: "_$E(PUR,1,35)
  1.  S @STORE@(DIV,TM,"TI",6)=""
  1.  I CUR+1>MAX S @STORE@(DIV,TM,"TI",7)="This team is not accepting patients."
  1.  I CUR<MAX,CUR'=MAX S @STORE@(DIV,TM,"TI",7)="This team is still accepting patients."
  1.  Q
  1.  ;
  1. FORMAT(POS,PPC,MAX,DIV,TM,TPOS,ROL,CNAME,SCPROV,SCPTASS) ;
  1.  ;
  1.  I POS="" S POS="[BAD DATA]"
  1.  S @STORE@(DIV,TM,"P",POS)=$E(POS,1,24) ;position
  1.  S $E(@STORE@(DIV,TM,"P",POS),27)=$E(SCPROV,1,24) ;provider
  1.  S $E(@STORE@(DIV,TM,"P",POS),53)=$E(ROL,1,24) ;standard role
  1.  S $E(@STORE@(DIV,TM,"P",POS),77)=PPC ;primary care yes/no
  1.  S $E(@STORE@(DIV,TM,"P",POS),82)=$J(MAX,6,0) ;number of patients allowed
  1.  S $E(@STORE@(DIV,TM,"P",POS),92)=$J(SCPTASS,6,0) ;patients assigned
  1.  S $E(@STORE@(DIV,TM,"P",POS),103)=$E(CNAME,1,30)
  1.  Q
  1.  ;
  1. FORMATAC(POS,DIV,TM,TPOS,CNAME) ;clinic name
  1.  S $E(@STORE@(DIV,TM,"P",POS,AC),103)=$E(CNAME,1,30)
  1.  Q
  1.  ;
  1. FORHEAD ;
  1.  S @STORE@("C",2)="Team Position"
  1.  S $E(@STORE@("C",2),27)="Provider Name"
  1.  S $E(@STORE@("C",2),53)="Standard Role"
  1.  S $E(@STORE@("C",2),77)="PC?"
  1.  S $E(@STORE@("C",1),82)="Patients"
  1.  S $E(@STORE@("C",2),82)="Allowed"
  1.  S $E(@STORE@("C",1),92)="Patients"
  1.  S $E(@STORE@("C",2),92)="Assigned"
  1.  S $E(@STORE@("C",2),103)="Associated Clinic"
  1.  S $P(@STORE@("C",3),"=",133)=""
  1.  Q
  1.  ;
  1. CONT ;Team continuation header
  1.  W !,"Team '",TNAME,"' continued..."
  1. COLUMN ;
  1.  I STOP Q
  1.  N EN
  1.  S EN=0
  1.  F  S EN=$O(@STORE@("C",EN)) Q:EN=""  D
  1.  .W !,$G(@STORE@("C",EN))
  1.  Q
  1.  ;