source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCMCRT1A.m@ 1487

Last change on this file since 1487 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1SCMCRT1A ;ALB/SCK - PCM TEAM PROFILE REPORT OUTPUT ; 10/30/95
2 ;;5.3;Scheduling;**41**;AUG 13, 1993
3 ;;1T1; Primary Care Management
4 ;
5 Q
6 ;
7TMRPT(SCBRK) ;
8 N PAGE,SCTEAM,SCPOST,SCWPND,SCWP,LINECNT
9 I '$D(^TMP("PCMTP",$J)) D NOREP G EXIT
10 U IO
11 S (PAGE,LINECNT,END)=0
12 ;D HDR Q:END
13 ;
14 S SCTEAM=""
15 F S SCTEAM=$O(^TMP("PCMTP",$J,SCTEAM)) Q:SCTEAM="" D:+SCBRK NEWPAGE D G:END EXIT
16 . N SCWPND
17 . D PRINT1(^TMP("PCMTP",$J,SCTEAM,0))
18 . S SCWP="",SCWPND=""
19 . F S SCWP=$O(^TMP("PCMTP",$J,SCTEAM,"D",SCWP)) Q:SCWP="" D Q:END
20 .. S SCWPND(SCWP)=^TMP("PCMTP",$J,SCTEAM,"D",SCWP)
21 . IF $D(SCWPND) D PRINTW(.SCWPND)
22 . D PRINT2(SCTEAM,^TMP("PCMTP",$J,SCTEAM,0))
23 . S SCPOST=""
24 . D PRINTCP Q:END
25 . F S SCPOST=$O(^TMP("PCMTP",$J,SCTEAM,"P",SCPOST)) Q:SCPOST="" D Q:END
26 .. D PRINTP(SCPOST,^TMP("PCMTP",$J,SCTEAM,"P",SCPOST))
27 . W !!
28 ;
29EXIT ;
30 D ^%ZISC
31 Q
32 ;
33PRINT1(SCNODE) ;
34 N X,X1
35 I $Y+5>IOSL D HDR Q:END
36 N SCSERV
37 S SCSERV=$P($G(SCNODE),U,6)
38 S X=$$SPACE(5)_"Team Name: "_$P($G(SCNODE),U)
39 S X=X_$$SPACE(45-$L(X))_"Service/Section: "_$E($P($G(^DIC(49,SCSERV,0)),U),1,20)
40 W !,X
41 ;
42 S X=$$SPACE(5)_"Team Telephone: "_$P($G(SCNODE),U,2)
43 W !,X
44 Q
45 ;
46PRINTCP ;
47 I $Y+8>IOSL D HDR Q:END
48 S X=$$SPACE(56)_"Provides Patients"
49 W !,X
50 S X=$$SPACE(5)_"Position"_$$SPACE(19)_"Standard Role"_$$SPACE(13)_"Care"_$$SPACE(10)_"Allowed"
51 W !,X
52 S X=$$SPACE(5)_"--------"_$$SPACE(19)_"-------------"_$$SPACE(13)_"--------"_$$SPACE(6)_"-------"
53 W !,X
54 Q
55 ;
56PRINT2(SCIEN,SCNODE) ;
57 N X
58 I $Y+8>IOSL D HDR Q:END
59 N SCPRP,SCMAX,SCINST
60 S SCPRP=$P($G(SCNODE),U,3)
61 S SCMAX=$P($G(SCNODE),U,8)
62 S SCINST=$P($G(SCNODE),U,7)
63 S X=$$SPACE(5)_"Team Settings:"
64 W !!,X
65 ;
66 S X=$$SPACE(6)_"Status: "_$S(+$$ACTHISTB^SCAPMCU2(404.58,SCIEN)=1:"ACTIVE",1:"INACTIVE")
67 S X=X_$$SPACE(45-$L(X))_"Purpose: "_$E($P($G(^SD(403.47,SCPRP,0)),U),1,20)
68 W !,X
69 ;
70 S X=$$SPACE(6)_"Maximum Patients: "_$S(SCMAX]"":SCMAX,1:0)
71 S X=X_$$SPACE(45-$L(X))_"Institution: "_$E($P($G(^DIC(4,SCINST,0)),U),1,20)
72 W !,X
73 ;
74 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")
75 W !!,X
76 ;
77 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.")
78 W !,X
79 Q
80 ;
81PRINTW(SCDES) ;
82 N NC,DIWL,DIWR,DIWF,WP
83 I $Y+5>IOSL D HDR Q:END
84 K ^UTILITY($J,"W")
85 S WP=$$SPACE(5)_"Team Description:"
86 W !!,WP
87 S DIWL=10,DIWR=80,DIWF="C60"
88 S NC=""
89 F S NC=$O(SCDES(NC)) Q:NC="" D D ^DIWW
90 . S X=SCDES(NC)
91 . D ^DIWP
92 ;
93 S X=""
94 F S X=$O(^UTILITY($J,"W",DIWL,X)) Q:X="" D
95 . S WP=$$SPACE(5)_^UTILTIY($J,"W",DIWL,1,0)
96 . W !,WP
97 W !
98 K ^UTILITY($J,"W")
99 Q
100 ;
101PRINTP(SCPOS,SCPNODE) ;
102 N X
103 I $Y+5>IOSL D HDR Q:END
104 S X=$$SPACE(4)_$S($P(SCPNODE,U,5)=1:">",1:" ")_$E(SCPOS,1,28)
105 S X=X_$$SPACE(31-$L(X))_$E($P(SCPNODE,U,2),1,25)
106 S X=X_$$SPACE(56-$L(X))_$P(SCPNODE,U,3)
107 S X=X_$$SPACE(70-$L(X))_$P(SCPNODE,U,4)
108 W !,X
109 Q
110 ;
111NOREP ;
112 W !!,"No Information for the Team Profile report"
113 Q
114 ;
115RPTHDR ;
116 S X=$$SPACE(5)_"Primary Care Management Team Profile Report"
117 W !,X
118 S X=$$SPACE(5)_"Report Date: "_$P($$NOW^VALM1,"@")
119 S X=X_$$SPACE(70-$L(X))_"Page: "_PAGE
120 W !,X,!!
121 Q
122 ;
123HDR ;
124 IF $E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S END='$T!(X="^") Q:END
125 ;
126HDR1 W:'($E(IOST,1,2)'="C-"&'PAGE) @IOF
127HDR2 S PAGE=PAGE+1
128 D RPTHDR
129 Q
130 ;
131LINE() ;
132 N X
133 S $P(X,"=",80)=""
134 Q X
135 ;
136SPACE(SCNUM) ;
137 N X
138 S $P(X," ",SCNUM)=""
139 Q X
140 ;
141WRITE(DEV,STR) ;
142 W @STR
143 Q
144 ;
145NEWPAGE ;
146 W @IOF
147 D HDR2
148 Q
Note: See TracBrowser for help on using the repository browser.