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

SCMCRT1A.m

Go to the documentation of this file.
  1. SCMCRT1A ;ALB/SCK - PCM TEAM PROFILE REPORT OUTPUT ; 10/30/95
  1. ;;5.3;Scheduling;**41**;AUG 13, 1993
  1. ;;1T1; Primary Care Management
  1. ;
  1. Q
  1. ;
  1. TMRPT(SCBRK) ;
  1. N PAGE,SCTEAM,SCPOST,SCWPND,SCWP,LINECNT
  1. I '$D(^TMP("PCMTP",$J)) D NOREP G EXIT
  1. U IO
  1. S (PAGE,LINECNT,END)=0
  1. ;D HDR Q:END
  1. ;
  1. S SCTEAM=""
  1. F S SCTEAM=$O(^TMP("PCMTP",$J,SCTEAM)) Q:SCTEAM="" D:+SCBRK NEWPAGE D G:END EXIT
  1. . N SCWPND
  1. . D PRINT1(^TMP("PCMTP",$J,SCTEAM,0))
  1. . S SCWP="",SCWPND=""
  1. . F S SCWP=$O(^TMP("PCMTP",$J,SCTEAM,"D",SCWP)) Q:SCWP="" D Q:END
  1. .. S SCWPND(SCWP)=^TMP("PCMTP",$J,SCTEAM,"D",SCWP)
  1. . IF $D(SCWPND) D PRINTW(.SCWPND)
  1. . D PRINT2(SCTEAM,^TMP("PCMTP",$J,SCTEAM,0))
  1. . S SCPOST=""
  1. . D PRINTCP Q:END
  1. . F S SCPOST=$O(^TMP("PCMTP",$J,SCTEAM,"P",SCPOST)) Q:SCPOST="" D Q:END
  1. .. D PRINTP(SCPOST,^TMP("PCMTP",$J,SCTEAM,"P",SCPOST))
  1. . W !!
  1. ;
  1. EXIT ;
  1. D ^%ZISC
  1. Q
  1. ;
  1. PRINT1(SCNODE) ;
  1. N X,X1
  1. I $Y+5>IOSL D HDR Q:END
  1. N SCSERV
  1. S SCSERV=$P($G(SCNODE),U,6)
  1. S X=$$SPACE(5)_"Team Name: "_$P($G(SCNODE),U)
  1. S X=X_$$SPACE(45-$L(X))_"Service/Section: "_$E($P($G(^DIC(49,SCSERV,0)),U),1,20)
  1. W !,X
  1. ;
  1. S X=$$SPACE(5)_"Team Telephone: "_$P($G(SCNODE),U,2)
  1. W !,X
  1. Q
  1. ;
  1. PRINTCP ;
  1. I $Y+8>IOSL D HDR Q:END
  1. S X=$$SPACE(56)_"Provides Patients"
  1. W !,X
  1. S X=$$SPACE(5)_"Position"_$$SPACE(19)_"Standard Role"_$$SPACE(13)_"Care"_$$SPACE(10)_"Allowed"
  1. W !,X
  1. S X=$$SPACE(5)_"--------"_$$SPACE(19)_"-------------"_$$SPACE(13)_"--------"_$$SPACE(6)_"-------"
  1. W !,X
  1. Q
  1. ;
  1. PRINT2(SCIEN,SCNODE) ;
  1. N X
  1. I $Y+8>IOSL D HDR Q:END
  1. N SCPRP,SCMAX,SCINST
  1. S SCPRP=$P($G(SCNODE),U,3)
  1. S SCMAX=$P($G(SCNODE),U,8)
  1. S SCINST=$P($G(SCNODE),U,7)
  1. S X=$$SPACE(5)_"Team Settings:"
  1. W !!,X
  1. ;
  1. S X=$$SPACE(6)_"Status: "_$S(+$$ACTHISTB^SCAPMCU2(404.58,SCIEN)=1:"ACTIVE",1:"INACTIVE")
  1. S X=X_$$SPACE(45-$L(X))_"Purpose: "_$E($P($G(^SD(403.47,SCPRP,0)),U),1,20)
  1. W !,X
  1. ;
  1. S X=$$SPACE(6)_"Maximum Patients: "_$S(SCMAX]"":SCMAX,1:0)
  1. S X=X_$$SPACE(45-$L(X))_"Institution: "_$E($P($G(^DIC(4,SCINST,0)),U),1,20)
  1. W !,X
  1. ;
  1. S X=$$SPACE(5)_$S($P($G(SCNODE),U,5)=1:"This team can provide primary care.",1:"This is not a primary care team")
  1. W !!,X
  1. ;
  1. S X=$$SPACE(5)_$S($P($G(SCNODE),U,10)=1:"This team is closed to further patients.",1:"This team is still accepting patients.")
  1. W !,X
  1. Q
  1. ;
  1. PRINTW(SCDES) ;
  1. N NC,DIWL,DIWR,DIWF,WP
  1. I $Y+5>IOSL D HDR Q:END
  1. K ^UTILITY($J,"W")
  1. S WP=$$SPACE(5)_"Team Description:"
  1. W !!,WP
  1. S DIWL=10,DIWR=80,DIWF="C60"
  1. S NC=""
  1. F S NC=$O(SCDES(NC)) Q:NC="" D D ^DIWW
  1. . S X=SCDES(NC)
  1. . D ^DIWP
  1. ;
  1. S X=""
  1. F S X=$O(^UTILITY($J,"W",DIWL,X)) Q:X="" D
  1. . S WP=$$SPACE(5)_^UTILTIY($J,"W",DIWL,1,0)
  1. . W !,WP
  1. W !
  1. K ^UTILITY($J,"W")
  1. Q
  1. ;
  1. PRINTP(SCPOS,SCPNODE) ;
  1. N X
  1. I $Y+5>IOSL D HDR Q:END
  1. S X=$$SPACE(4)_$S($P(SCPNODE,U,5)=1:">",1:" ")_$E(SCPOS,1,28)
  1. S X=X_$$SPACE(31-$L(X))_$E($P(SCPNODE,U,2),1,25)
  1. S X=X_$$SPACE(56-$L(X))_$P(SCPNODE,U,3)
  1. S X=X_$$SPACE(70-$L(X))_$P(SCPNODE,U,4)
  1. W !,X
  1. Q
  1. ;
  1. NOREP ;
  1. W !!,"No Information for the Team Profile report"
  1. Q
  1. ;
  1. RPTHDR ;
  1. S X=$$SPACE(5)_"Primary Care Management Team Profile Report"
  1. W !,X
  1. S X=$$SPACE(5)_"Report Date: "_$P($$NOW^VALM1,"@")
  1. S X=X_$$SPACE(70-$L(X))_"Page: "_PAGE
  1. W !,X,!!
  1. Q
  1. ;
  1. HDR ;
  1. IF $E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S END='$T!(X="^") Q:END
  1. ;
  1. HDR1 W:'($E(IOST,1,2)'="C-"&'PAGE) @IOF
  1. HDR2 S PAGE=PAGE+1
  1. D RPTHDR
  1. Q
  1. ;
  1. LINE() ;
  1. N X
  1. S $P(X,"=",80)=""
  1. Q X
  1. ;
  1. SPACE(SCNUM) ;
  1. N X
  1. S $P(X," ",SCNUM)=""
  1. Q X
  1. ;
  1. WRITE(DEV,STR) ;
  1. W @STR
  1. Q
  1. ;
  1. NEWPAGE ;
  1. W @IOF
  1. D HDR2
  1. Q