source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRGPRT.m@ 1499

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1PXRRGPRT ;ISL/PKR - PCE reports general printing routines. 4/17/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,12,20**;Aug 12, 1996
3 ;
4 ;=======================================================================
5CLASSNE(INDENT) ;Print the selected Person Classes that had no encounters.
6 ;PXRRPECL is the input list, the fourth piece is "M" if a match was
7 ;found.
8 N CLS,IC,NOMATCH,TEMP
9 S NOMATCH=0
10 F IC=1:1:NCL Q:NOMATCH D
11 . I $P(PXRRPECL(IC),U,4)'="M" S NOMATCH=1
12 ;
13 ;Print the list.
14 I NOMATCH D
15 . W !!,?INDENT,"The following selected Person Classes had no encounters that met the"
16 . W !,?INDENT,"selection criteria:"
17 . S CLS=INDENT+INDENT
18 . F IC=1:1:NCL D
19 .. S TEMP=PXRRPECL(IC)
20 .. I $P(TEMP,U,4)'="M" D
21 ... W !!,?CLS,"Occupation: ",$P(TEMP,U,1)
22 ... W !,?CLS,"Specialty: ",$P(TEMP,U,2)
23 ... W !,?CLS,"Subspecialty: ",$P(TEMP,U,3)
24 Q
25 ;
26 ;=======================================================================
27FACNE(INDENT) ;Print the selected facilities that had no encounters.
28 ;PXRRFAC is the input list, the fourth piece is "M" if a match was
29 ;found.
30 N IC,IND,NOMATCH,TEMP
31 S NOMATCH=0
32 F IC=1:1:NFAC Q:NOMATCH D
33 . I $P(PXRRFAC(IC),U,4)'="M" S NOMATCH=1
34 ;
35 ;Print the list.
36 I NOMATCH D
37 . W !!,"The following selected Facilities had no encounters that met the selection"
38 . W !,"criteria:"
39 . F IC=1:1:NFAC D
40 .. I $P(PXRRFAC(IC),U,4)'="M" D
41 ... S IND=$P(PXRRFAC(IC),U,1)
42 ... S TEMP=PXRRFACN(IND)
43 ... W !,?INDENT,$P(TEMP,U,1)," ",$P(TEMP,U,2)
44 Q
45 ;
46 ;=======================================================================
47HDR(PAGE) ;
48 I $E(IOST)="C",IO=IO(0) W @IOF
49 E W !
50 N TEMP,TEXTLEN
51 S TEMP=$$NOW^XLFDT,TEMP=$$FMTE^XLFDT(TEMP,"P")
52 S TEMP=TEMP_" Page "_PAGE
53 S TEXTLEN=$L(TEMP)
54 W ?(IOM-TEXTLEN),TEMP
55 ;PXRROPT should be newed in the main driver.
56 I '$D(PXRROPT) D
57 . S PXRROPT=$$TITLE
58 . I ($L(PXRROPT)>0)&(PXRROPT'["PCE") S PXRROPT="PCE "_PXRROPT
59 S TEXTLEN=$L(PXRROPT)
60 I TEXTLEN>0 D
61 . W !!
62 . W ?((IOM-TEXTLEN)/2),PXRROPT
63 Q
64 ;
65 ;=======================================================================
66OLRCRIT(PSTART) ;Output the location report criteria.
67 N ED,SD
68 W !?PSTART,"Location selection criteria:",?32,$P(PXRRLCSC,U,2)
69 S SD=$$FMTE^XLFDT(PXRRBDT)
70 S ED=$$FMTE^XLFDT(PXRREDT)
71 W !?PSTART,"Encounter date range:",?32,SD," through ",ED
72 I $D(PXRRSCAT) D OSCAT(PXRRSCAT,PSTART)
73 I $D(PXRRENTY) D OENTYPE(PXRRENTY,PSTART)
74 W !,"___________________________________________________________________"
75 Q
76 ;
77 ;=======================================================================
78OENTYPE(ENTYL,PSTART) ;Output the encounter types used for screening the encounters.
79 N IC,CSTART,EM,ENTYPE,ENTTEXT
80 S CSTART=PSTART+3
81 W !,?PSTART,"Encounter types:",?32,ENTYL
82 F IC=1:1:$L(ENTYL) D
83 . S ENTYPE=$E(ENTYL,IC,IC)
84 . S ENTTEXT=$$EXTERNAL^DILFD(9000010,15003,"",ENTYPE,.EM)
85 . W !,?CSTART,ENTYPE," - ",ENTTEXT
86 Q
87 ;
88 ;=======================================================================
89OPRCRIT(PSTART) ;Output the provider report criteria.
90 N ED,SD
91 W !?PSTART,"Provider selection criteria:",?32,$P(PXRRPRSC,U,2)
92 S SD=$$FMTE^XLFDT(PXRRBDT)
93 S ED=$$FMTE^XLFDT(PXRREDT)
94 W !?PSTART,"Report date range:",?32,SD," through ",ED
95 D OSCAT(PXRRSCAT,PSTART)
96 I $P($G(PXRRPRSC),U,1)="C" D PECLASS^PXRRGPRT(PSTART)
97 I $D(PXRRENTY) D OENTYPE(PXRRENTY,PSTART)
98 W !,"___________________________________________________________________"
99 Q
100 ;
101 ;=======================================================================
102OSCAT(SCL,PSTART) ;Output the service categeories used for screening the encounters.
103 N IC,CSTART,EM,SC,SCTEXT
104 S CSTART=PSTART+3
105 W !,?PSTART,"Service categories:",?32,SCL
106 F IC=1:1:$L(SCL) D
107 . S SC=$E(SCL,IC,IC)
108 . S SCTEXT=$$EXTERNAL^DILFD(9000010,.07,"",SC,.EM)
109 . W !,?CSTART,SC," - ",SCTEXT
110 Q
111 ;
112 ;=======================================================================
113PAGE ;form feed to new page
114 I ($E(IOST)="C")&(IO=IO(0)) D
115 . S DIR(0)="E"
116 . W !
117 . D ^DIR K DIR
118 I $D(DUOUT)!($D(DTOUT)) S DONE=1 Q
119 W:$D(IOF) @IOF
120 S PAGE=PAGE+1
121 D HDR^PXRRGPRT(PAGE)
122 S HEAD=1
123 Q
124 ;
125 ;=======================================================================
126PECLASS(CLS) ;Print the list of selected Person Classes.
127 N IC,TEMP
128 S TEMP=$P(PXRRPRSC,U,2)_": "
129 W !!,TEMP
130 F IC=1:1:NCL D
131 . S TEMP=PXRRPECL(IC)
132 . I IC>1 W !
133 . W !,?CLS,"Occupation: ",$P(TEMP,U,1)
134 . W !,?CLS,"Specialty: ",$P(TEMP,U,2)
135 . W !,?CLS,"Subspecialty: ",$P(TEMP,U,3)
136 Q
137 ;
138 ;=======================================================================
139PTOTAL(TEXT,TOTAL,END,LINE) ;Print totals.
140 N IC,TEXLEN,TOTLEN
141 S TEXLEN=$L(TEXT)
142 S TOTLEN=$L(TOTAL)
143 I LINE D
144 . W !,?(END-TOTLEN-1) F IC=1:1:TOTLEN+2 W "_"
145 W !,?(END-TEXLEN-TOTLEN),TEXT,?(END-TOTLEN),TOTAL,!
146 Q
147 ;
148 ;=======================================================================
149TITLE() ;Set title from option file name.
150 N XQOPT
151 I +$G(XQY)>0 D OP^XQCHK
152 Q $P($G(XQOPT),U,2)
153 ;
Note: See TracBrowser for help on using the repository browser.