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

SCMCRT1.m

Go to the documentation of this file.
  1. SCMCRT1 ;ALB/SCK - TEAM PROFILE REPORT ; 10/30/95
  1. ;;5.3;Scheduling;**41**;AUG 13, 1993
  1. ;;1T1;Primary Care Management Module
  1. ;
  1. ; Routine for collecting Team information for the
  1. ; Team Profile report
  1. ;
  1. START(SCTS,SCPS,SCTEAMS,SCBRK) ;
  1. ; SCTS = Team Status
  1. ; SCPS = Positon status
  1. ; SCBRK = Page break as team changes
  1. ;
  1. ; Status values:
  1. ; 1 Show active only
  1. ; 0 Show inactive only
  1. ; -1 Show all
  1. ; 10 Selected Teams
  1. ;
  1. ; SCTEAMS = List of teams to print
  1. ;
  1. N SCTM,SCTMIEN,SCI,SCDTRNG,SCERMSG,SCRTN
  1. K ^TMP("PCMTP")
  1. S SCDTRNG=""
  1. ;
  1. IF $G(SCTS)=10,$G(SCTEAMS)=0 D G CONT
  1. . S SCTM=""
  1. . F S SCTM=$O(SCTEAMS(SCTM)) Q:SCTM="" D
  1. .. D BLD(SCTM)
  1. ;
  1. S SCTM=""
  1. F S SCTM=$O(^SCTM(404.51,"B",SCTM)) Q:SCTM="" D
  1. . S SCTMIEN="",SCTMIEN=$O(^SCTM(404.51,"B",SCTM,SCTMIEN))
  1. . Q:'$$TEAMOK(SCTS,SCTMIEN)
  1. . D BLD(SCTMIEN)
  1. ;
  1. CONT ;
  1. D TMRPT^SCMCRT1A(SCBRK)
  1. Q
  1. ;
  1. TEAMOK(SCACT,SCIEN) ; function to check teams current status against
  1. ; the requested status
  1. ;
  1. ; SCACT - See status values above
  1. ; SCIEN - IEN value for the team in 404.51
  1. ;
  1. ; Returns 0 if team does not meet requested status,
  1. ; 1 if team does meet the requested status.
  1. ;
  1. ;
  1. N SCRTN,SCOK,SCER
  1. S SCOK=1
  1. G:SCACT<0 TEAMOKQ
  1. IF '+$$ACTHIST^SCAPMCU1(404.58,SCIEN,"SCDTRNG","SCER") S SCOK=0
  1. TEAMOKQ Q (SCOK)
  1. ;
  1. POSTOK(SCPACT,SCIEN) ; function to check a positions current status against
  1. ; against the requested status
  1. ;
  1. ; SCPACT - See status values above
  1. ; SCIEN - Ien value for the position in the 404.57 file
  1. ;
  1. ; Returns 0 if position does not meet requested status
  1. ; 1 if position does meet the status
  1. ;
  1. N SCOK,SCER
  1. S SCOK=1
  1. G:SCPACT<0 POSTOKQ
  1. IF '+$$ACTHIST^SCAPMCU1(404.59,SCIEN,"SCDTRNG","SCER") S SCOK=0
  1. POSTOKQ Q (SCOK)
  1. ;
  1. BLD(SCIEN) ; Build entry for the team profile in ^TMP("PCMTP",$J)
  1. ;
  1. ; Team information is on the zero node. The format is the same
  1. ; as for the zero node in file #404.51
  1. ;
  1. ; The team description (WP field nodes) are on the "D" node.
  1. ; The teams positions are on individual "P" nodes, by name.
  1. ; Format is position ien^standard role (external)^primary care^
  1. ; max patients allowed^active status.
  1. ;
  1. N SCTNODE,II,SCPNODE,SCPIEN
  1. S SCTNODE=$G(^SCTM(404.51,SCIEN,0))
  1. Q:$D(SCTNODE)=0
  1. ;
  1. ; Loop thru all the teams in file 404.51 and build the zero node
  1. ; for the requested teams
  1. ;
  1. S ^TMP("PCMTP",$J,SCIEN,0)=SCTNODE
  1. IF $D(^SCTM(404.51,SCIEN,"D")) D
  1. . S II=0
  1. . F S II=$O(^SCTM(404.51,SCIEN,"D",II)) Q:II="" D
  1. .. S ^TMP("PCMTP",$J,SCIEN,"D",II)=$G(^SCTM(404.51,SCIEN,"D",II,0))
  1. ;
  1. ; For each team, loop thru all the team positions, and build
  1. ; nodes for each position that matches the requested status
  1. ;
  1. S SCPIEN=""
  1. F S SCPIEN=$O(^SCTM(404.57,"C",SCIEN,SCPIEN)) Q:SCPIEN="" D
  1. . Q:'$$POSTOK(SCPS,SCPIEN)
  1. . S SCPNODE=$G(^SCTM(404.57,SCPIEN,0))
  1. . S ^TMP("PCMTP",$J,SCIEN,"P",$P(SCPNODE,U))=SCPIEN_"^"_$$ROLE($P(SCPNODE,U,3))_"^"_$$CARE($P(SCPNODE,U,4))_"^"_+$P(SCPNODE,U,8)_"^"_$$ACTPOS(SCPIEN)
  1. ;
  1. IF $D(^TMP("PCMTP",$J,SCIEN,"P"))=0 S ^TMP("PCMTP",$J,SCIEN,"P","NO POSITIONS")=""
  1. Q
  1. ;
  1. ACTPOS(SCIEN) ; Returns the active status of the position for the
  1. ; date range of the report.
  1. ;
  1. N SCSTAT,SCER
  1. S SCTAT=$$ACTHIST^SCAPMCU1(404.59,SCIEN,"SCDTRNG","SCER")
  1. Q +SCTAT
  1. ;
  1. ROLE(SCIEN) ; Returns the standard role for a position in external format
  1. ;
  1. N SCROLE
  1. S SCROLE="NO STANDARD ROLE"
  1. G:$G(SCIEN)="" ROLEQ
  1. S SCROLE=$P($G(^SD(403.46,SCIEN,0)),U)
  1. ROLEQ Q SCROLE
  1. ;
  1. CARE(SCC) ; Returns Yes if the position can provide primary care, No
  1. ; if the position cannot.
  1. ;
  1. N STAT
  1. S STAT="NO"
  1. S:SCC=1 STAT="YES"
  1. CAREQ Q STAT
  1. ;
  1. QSTART ;
  1. D START(SCTMS,SCPOS,.SCTEAMS,SCBRK)
  1. Q