source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRWLD.m@ 738

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

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
[613]1PXRRWLD ;ISL/PKR,ALB/Zoltan - Driver for PCE encounter summary report.;12/1/98
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61**;Aug 12, 1996
3MAIN ;
4 N PXRRIOD,PXRRWLJB,PXRRWLST,PXRROPT,PXRRQUE,PXRRXTMP
5 S PXRRXTMP=$$PXRRXTMP("PXRRWL")
6 S ^XTMP(PXRRXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRR Encounter Summary"
7 ;
8 ;Establish the selection criteria.
9FAC ;Get the facility list.
10 N NFAC,PXRRFAC,PXRRFACN
11 D FACILITY^PXRRLCSC
12 I $D(DTOUT)!$D(DUOUT) G EXIT
13 ;
14LORP ;See if the report is to be by location or provider.
15 N PXRRWLSC
16 D WHICH("L")
17 I $D(DTOUT) G EXIT
18 I $D(DUOUT) G FAC
19 ;
20LOC ;Get the location(s) for the report.
21 N NCS,NHL,PXRRCS,PXRRLCHL,PXRRLCSC
22 I $P(PXRRWLSC,U,1)="L" D
23 . S PXRRLCSC=""
24 . D LOC^PXRRLCSC("Select ENCOUNTER LOCATION CRITERIA","HS")
25 . I $P(PXRRLCSC,U,1)["C" D BYLOC^PXRRLCSC
26 I $D(DTOUT) G EXIT
27 I $D(DUOUT) G LORP
28 ;
29PRV ;Get the provider(s) for the report.
30 N NCL,NPL,PXRRPECL,PXRRPRLL,PXRRPRPL,PXRRPRSC
31 N PXRRMPR
32 S PXRRMPR=0
33 I $P(PXRRWLSC,U,1)="P" D
34 . D PRV^PXRRPRSC
35 . I ('$D(DTOUT))&('$D(DUOUT)) D
36 .. K DIRUT,DTOUT,DUOUT
37 .. S DIR(0)="YA"
38 .. S DIR("A",1)="Do you want providers broken out by location?"
39 .. S DIR("A")="Enter Y (YES) or N (NO) "
40 .. S DIR("B")="N"
41 .. W !
42 .. D ^DIR K DIR
43 .. I $D(DIROUT) S DTOUT=1
44 .. S PXRRPRLL=Y
45 I $D(DTOUT) G EXIT
46 I $D(DUOUT) G LORP
47 ;
48DR ;Get the date range.
49 N PXRRBDT,PXRREDT
50 D PDR^PXRRADUT(.PXRRBDT,.PXRREDT,"ENCOUNTER")
51 I $D(DTOUT) G EXIT
52 I $D(DUOUT) G LORP
53 ;
54SCAT ;Get the service categories.
55 N PXRRSCAT
56 D SCAT^PXRRECSC
57 I $D(DTOUT) G EXIT
58 I $D(DUOUT) G DR
59 ;
60ENTY ;Get the encounter types.
61 N PXRRENTY
62 D ENTYPE^PXRRECSC
63 I $D(DTOUT) G EXIT
64 I $D(DUOUT) G SCAT
65 ;
66 ;Determine whether the report should be queued.
67 S %ZIS="QM"
68 W !
69 D ^%ZIS
70 I POP G EXIT
71 S PXRRIOD=ION_";"_IOST_";"_IOM_";"_IOSL
72 S PXRRQUE=$G(IO("Q"))
73 ;
74 I PXRRQUE D
75 . ;Queue the report.
76 . N DESC,IODEV,ROUTINE
77 . S DESC="Encounter Summary Report - sort encounters"
78 . S IODEV=""
79 . S ROUTINE="SORT^PXRRWLSE"
80 . S ^XTMP(PXRRXTMP,"SEZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
81 .;
82 . S DESC="Encounter Summary Report - sort appointments"
83 . S IODEV=""
84 . S ROUTINE="SORT^PXRRWLSA"
85 . S ZTDTH="@"
86 . S ^XTMP(PXRRXTMP,"SAZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
87 .;
88 . S DESC="Encounter Summary Report - print"
89 . S IODEV=PXRRIOD
90 . S ROUTINE="PXRRWLPR"
91 . S ZTDTH="@"
92 . S ^XTMP(PXRRXTMP,"PRZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
93 ;
94 E D SORT^PXRRWLSE
95 Q
96 ;=======================================================================
97EXIT ;
98 D EXIT^PXRRGUT
99 Q
100 ;
101 ;=======================================================================
102SAVE ;Save the variables.
103 S ZTSAVE("PXRRBDT")="",ZTSAVE("PXRREDT")=""
104 S ZTSAVE("PXRRCS(")="",ZTSAVE("NCS")=""
105 S ZTSAVE("PXRRENTY")=""
106 S ZTSAVE("PXRRFAC(")="",ZTSAVE("NFAC")=""
107 S ZTSAVE("PXRRFACN(")=""
108 S ZTSAVE("PXRRIOD")=""
109 S ZTSAVE("PXRRLCHL(")="",ZTSAVE("NHL")=""
110 S ZTSAVE("PXRRLCSC")=""
111 S ZTSAVE("PXRRPECL(")="",ZTSAVE("NCL")=""
112 S ZTSAVE("PXRRPRLL")=""
113 S ZTSAVE("PXRRPRPL(")="",ZTSAVE("NPL")=""
114 S ZTSAVE("PXRRPRSC")=""
115 S ZTSAVE("PXRRQUE")=""
116 S ZTSAVE("PXRRSCAT")=""
117 S ZTSAVE("PXRRXTMP")=""
118 S ZTSAVE("PXRRWLSC")=""
119 S ZTSAVE("PXRRMPR")=""
120 Q
121 ;
122 ;=======================================================================
123WHICH(DEFAULT) ;Find out if the report is to be by location or provider.
124 N X,Y
125 K DIROUT,DIRUT,DTOUT,DUOUT
126 S DIR(0)="S"_U_"L:Location;"
127 S DIR(0)=DIR(0)_"P:Provider"
128 S DIR("A")="Do the report by"
129 S DIR("B")=DEFAULT
130 W !!,"This report may be done by location or provider"
131 D ^DIR K DIR
132 I $D(DIROUT) S DTOUT=1
133 I $D(DTOUT)!($D(DUOUT)) Q
134 S PXRRWLSC=Y_U_Y(0)
135 Q
136 ;
137PXRRXTMP(PXPFX) ; Extrinsic variable.
138 ; Gets a unique PXRRXTMP value.
139 S PFPFX=$G(PXPFX,"PXRRXTMP") ; Unizue ^XTMP prefix.
140 N PXRRXTMP ; Value to return.
141 N PXDONE
142 I '$D(^XTMP("PXRRXTMP")) D
143 . N PXCREATE ; ^XTMP Creation date.
144 . N PXPURGE ; ^XTMP Purge date.
145 . L +^XTMP("PXRRXTMP",0):300
146 . S PXCREATE=$$DT^XLFDT ; Today's date.
147 . S PXPURGE=$$HTFM^XLFDT($H+365) ; Not more than one year from today.
148 . S ^XTMP("PXRRXTMP",0)=PXCREATE_"^"_PXPURGE_"^PXRR XTMP Coordination"
149 . L -^XTMP("PXRRXTMP",0)
150 L +^XTMP("PXRRXTMP",1):300
151 S PXDONE=0
152 F D Q:PXDONE
153 . S (^XTMP("PXRRXTMP",1),PXRRXTMP)=$G(^XTMP("PXRRXTMP",1),0)+1
154 . S PXRRXTMP=PXPFX_PXRRXTMP
155 . Q:$D(^XTMP(PXRRXTMP))
156 . Q:$D(^TMP(PXRRXTMP))
157 . Q:$D(^TMP($J,PXRRXTMP))
158 . S PXDONE=1
159 L -^XTMP("PXRRXTMP",1)
160 Q PXRRXTMP
Note: See TracBrowser for help on using the repository browser.