source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDSCRPT2.m@ 949

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1SDSCRPT2 ;ALB/JAM/RBS - ASCD SB/Reports for Service Connected Automated Monitor ; 3/5/07 12:11pm
2 ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
3 ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
4 ;;known as Service Connected Automated Monitoring (SCAM).
5 ;
6 ; Routine should be called at specified tags only.
7 Q
8HEADER ; Display an appropriate header for this report.
9 ; Do standard header setup
10 D STDHDR Q:$G(SDABRT)=1
11 W "O/P ENCOUNTERS THAT ARE "_$S('SDOPT:"NOT ",1:"")_"SERVICE CONNECTED" W:SDOPT=2 " & NON SERVICE CONNECTED" W ?67,"PAGE: ",P
12 W !,?5,"ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
13 I $G(SDSCDNM)'="" W " By Division: "_SDSCDNM
14 W !,"DATE",?18,"PATIENT",?50,"ENCOUNTER",?65,"SC VALUE",!,!
15 Q
16 ;
17ENCBDDT ; Detailed Body of the Disability/POV Encounter report
18 I L+3+$S(SDDET:$$CTPOV(),1:0)>IOSL D HEADER Q:$G(SDABRT)=1
19 ; Display the Encounter date
20 W $$FMTE^XLFDT(SDOEDT,"5MZ")
21 N DFN,VADM S DFN=SDPAT D DEM^VADPT
22 ; Display the patient name and last 4 SSN.
23 W ?18,$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
24 D KVA^VADPT
25 ; Display the ENCOUNTER Number
26 W ?50,SDOE,?65,$S(SCVAL:"YES",SCVAL=0:"NO",1:"TBD"),! S L=L+1
27 ; If summary report, quit.
28 Q:SDDET=0
29 ; Display all ICD CODES and DIAGNOSES for the specified encounter.
30 I L+2+$$CTPOV()>IOSL D HEADER Q:$G(SDABRT)=1
31 D POV2S
32 I L+2+$$CTDIS()>IOSL D HEADER Q:$G(SDABRT)=1
33 D DIS2S
34 I L+4>IOSL D HEADER Q:$G(SDABRT)=1
35 W !,! S L=L+2
36 Q
37 ;
38NBILLHD ; Display an appropriate header for this report.
39 ; Do standard header setup
40 D STDHDR Q:$G(SDABRT)=1
41 W SDHDR,?67,"PAGE: ",P
42 W !,?5,"FOR ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
43 I $G(SDSCDNM)'="" W " By Division: "_SDSCDNM
44 W !,"DATE",?18,"PATIENT",?50,"ENCOUNTER",!,!
45 Q
46 ;
47NBILLBD ; Body of the Non Service Connected Billable Encounter reports
48 I L+2>IOSL D NBILLHD Q:$G(SDABRT)=1
49 ; Display the Encounter date
50 W $$FMTE^XLFDT(SDOEDT,"5MZ")
51 ; Display the patient name and last 4 SSN.
52 N DFN,VADM S DFN=SDPAT D DEM^VADPT
53 W ?18,$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
54 ; Display the ENCOUNTER Number
55 W ?50,SDOE,! S L=L+1
56 I L+5>IOSL D NBILLHD Q:$G(SDABRT)=1
57 Q
58 ;
59PRVHD ; Display the header for the Provider Service Connected Review Report.
60 ; Do standard header setup
61 D STDHDR Q:$G(SDABRT)=1
62 S SDNWPV=1
63 W SDHDR,?67,"PAGE: ",P
64 W !,?5,"FOR ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
65 I $G(SDSCDNM)'="" W " By Division: "_SDSCDNM
66 W !,?5,"ENCOUNTER DATE",?23,"PATIENT NAME",?56,"ENC #",?65,"VBA SC",?73,"USER SC",!,!
67 Q
68 ;
69PRVBD ; Body of the Provider Service Connected Review Report
70 ; This routine will display the Activity during a review
71 ; Start a new page for every provider.
72 N SDSCCVB,SDSCCUB,DFN,VADM
73 I L+3+$S(SDDET:$$CTPOV(),1:0)>IOSL D PRVHD Q:$G(SDABRT)=1 S SDPVCN=1
74 ; Display the Provider, reset new provider print flag
75 I SDNWPV=1 D
76 . W $$UP^XLFSTR($$NAME^XUSER(SDPROV,"F"))
77 . S SDNWPV=0
78 . I SDPVCN=1 W " (cont'd)" S SDPVCN=0
79 . W ! S L=L+1
80 . Q
81 ; Display the Encounter date
82 W ?5,$$FMTE^XLFDT(SDOEDT,"5MZ")
83 ; Display the Patient Name
84 S DFN=SDPAT D DEM^VADPT
85 W ?23,$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
86 D KVA^VADPT
87 ; Display the ENCOUNTER Number,VBA/ICD Connected,VBA by User. Increment Line Count.
88 S SDSCCVB=$$GET1^DIQ(409.48,SDOE,.09,"E")
89 S SDSCCUB=$$GET1^DIQ(409.48,SDOE,.06,"E")
90 I SDSCCUB="" S SDSCCUB="TBD"
91 W ?56,SDOE,?65,SDSCCVB,?73,SDSCCUB
92 I 'SDDET W ! S L=L+1
93 I SDDET D Q:$G(SDABRT)=1
94 . ; check for enough room for return prompt and data.
95 . I L+2+$$CTPOV()>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
96 . D POV2S
97 . I L+2+$$CTDIS()>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
98 . D DIS2S
99 . I L+4>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
100 . W !,! S L=L+2
101 . Q
102 I L+3>IOSL D PRVHD Q:$G(SDABRT)=1 S SDPVCN=1
103 Q
104 ;
105RVWHD ; Display the header for the User Service Connected Review Report.
106 ; Do standard header setup
107 D STDHDR Q:$G(SDABRT)=1
108 S SDNWPV=1
109 W SDHDR,?67,"PAGE: ",P
110 W !,?5,"FOR ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
111 I $G(SDSCDNM)'="" W " By Division: "_SDSCDNM
112 W !,?5,"ENCOUNTER DATE",?23,"ENC #",?33,"VBA SC",?40,"USER SC",?50,"STATUS",?60,"DATE LAST EDITED",!,!
113 Q
114 ;
115RVWBD ; Body of the User Service Connected Review Report
116 ; This routine will display the Activity during a review
117 ; Start a new page for every user.
118 N SDSCCVB,SDSCCUB
119 I L+3+$S(SDDET:$$CTPOV(),1:0)>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
120 ; Display the Encounter date
121 I SDNWPV=1 D
122 . W $$UP^XLFSTR($$NAME^XUSER(SDLEB,"F"))
123 . S SDNWPV=0
124 . I SDPVCN=1 W " (cont'd)" S SDPVCN=0
125 . W ! S L=L+1
126 ; Display the Encounter date
127 W ?5,$$FMTE^XLFDT(SDOEDT,"5MZ")
128 ; Display the ENCOUNTER Number,VBA/ICD Connected,VBA by User, and Status. Increment Line Count.
129 S SDSCCVB=$$GET1^DIQ(409.48,SDOE,.09,"E")
130 S SDSCCUB=$$GET1^DIQ(409.48,SDOE,.06,"E")
131 I SDSCCUB="" S SDSCCUB="TBD"
132 W ?23,SDOE,?33,SDSCCVB,?40,SDSCCUB
133 W ?48,$$GET1^DIQ(409.48,SDOE,.05,"E")
134 W ?60,$$FMTE^XLFDT($$GET1^DIQ(409.48,SDOE,.02,"E"),"5MZ")
135 I 'SDDET W ! S L=L+1
136 I SDDET D Q:$G(SDABRT)=1
137 . ; check for enough room for return prompt and data.
138 . I L+2+$$CTPOV()>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
139 . D POV2S
140 . I L+2+$$CTDIS()>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
141 . D DIS2S
142 . I L+4>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
143 . W !,! S L=L+2
144 I L+3>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
145 Q
146 ;
147CTPOV() ; Count all POV entries for the specified visit.
148 N SDCT,SDVPOV0
149 S SDCT=2
150 S SDVPOV0=0 F S SDVPOV0=$O(^AUPNVPOV("AD",SDV0,SDVPOV0)) Q:'SDVPOV0 S SDCT=SDCT+1
151 Q SDCT
152 ;
153CTDIS() ; Count all rated disabilities for this patient.
154 N I,I3,SCRD
155 S I3=2,I=0
156 D RDIS^DGRPDB(SDPAT,.SCRD)
157 F S I=$O(SCRD(I)) Q:'I S I3=I3+1
158 Q I3
159 ;
160POV2S ; Loop through and display all POV entries for the specified visit.
161 N SDICD,SDVPOV0
162 W !!,?10,"POVs/ICDs:" S L=L+2
163 S SDVPOV0=0 F S SDVPOV0=$O(^AUPNVPOV("AD",SDV0,SDVPOV0)) Q:'SDVPOV0 D
164 . S SDPOV=$P($G(^AUPNVPOV(SDVPOV0,0)),U),SDICD=$$ICDDX^ICDCODE(SDPOV)
165 . W !?15,$P(SDICD,U,2),?23,$P(SDICD,U,4) S L=L+1
166 . Q
167 Q
168 ;
169DIS2S ; Loop through and display all rated disabilities for this patient.
170 W !!,?10,"Rated Disabilities:" S L=L+2
171 N I,I1,I2,I3,SCRD
172 D RDIS^DGRPDB(SDPAT,.SCRD)
173 S I3=0,I=0 F S I=$O(SCRD(I)) Q:'I D
174 . S I1=SCRD(I)
175 . S I2=$S($D(^DIC(31,+I1,0)):$P(^(0),U,3)_" "_$P(^(0),"^",1)_" ("_+$P(I1,"^",2)_"%-"_$S($P(I1,"^",3):"SC",$P(I1,"^",3)']"":"not specified",1:"NSC")_")",1:""),I3=I3+1
176 . W !,?15,I2 S L=L+1
177 . Q
178 Q
179 ;
180STDHDR ; tag for all of the standard report header calls
181 ; Do not ask 'RETURN' before first page on CRT.
182 I $E(IOST,1,2)="C-",P N DIR,Y S DIR(0)="E" D ^DIR I 'Y S SDABRT=1 Q
183 ; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
184 I $E(IOST,1,2)="C-"!P W @IOF
185 S P=P+1,L=5
186 Q
Note: See TracBrowser for help on using the repository browser.