source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDSCMSR.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1SDSCMSR ;ALB/JAM/RBS - ASCD Managers Summary Data Report ; 3/5/07 11:44am
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 ;**Program Description**
7 ; This report is to be used by managers only
8 Q
9EN ; Entry Point
10 N ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE,SDSCDVSL,SDSCDVLN,WHO,DIR,X,Y
11 N SDSCBDT
12 K ^TMP("SDSCMGR",$J)
13 ; Get Divisions
14 D DIV^SDSCUTL
15 D ^DIR
16 I $G(DTOUT)!($G(DUOUT)) G EXIT
17 S SDSCDVSL=Y,SDSCDVLN=SCLN
18 ; Get start and end date for report
19 S (SDSCBDT,SDSCEDT)=""
20 S SDSCBDT=$O(^SCE("B",""))\1,SDSCEDT=DT
21 D GETDATE1^SDSCOMP I SDSCTDT="" G EXIT
22 K DIR,X,Y
23 S DIR(0)="S^A:All Encounters;C:Compiled ASCD Encounters Only"
24 S DIR("A")="Select to check ",DIR("B")="Compiled ASCD Encounters Only"
25 D ^DIR
26 I $G(DTOUT)!($G(DUOUT)) G EXIT
27 S WHO=Y
28 K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP EXIT
29 I $D(IO("Q")) D G EXIT
30 . S ZTRTN="BEG^SDSCMSR",ZTDTH=$H,ZTDESC="ASCD Manager Summary Report"
31 . S ZTSAVE("WHO")="",ZTSAVE("SDSCBDT")="",ZTSAVE("SDSCEDT")="",ZTSAVE("SDSCDVSL")=""
32 . S ZTSAVE("SDSCDVLN")="",ZTSAVE("SDEDT")="",ZTSAVE("SDSCTDT")=""
33 . K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED"
34 ;
35BEG ; Begin report
36 N DTOTAL,DATOTAL,CT,P,L,SDABRT,AJ,DTOT,SDSCDIV,SDSCDNM,THDR,AI
37 S (DTOTAL,DATOTAL,CT)=0
38 S (P,L,SDABRT)=0
39 F AJ="VBA","NO CHANGE","SCNSC","NSCSC","REV","NOT","NPROC" S DTOT(AJ)=0
40 S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
41 I SDSCDIV="" S SDSCDNM="ALL" D BLD G EXT
42 I SDSCDIV'="" D
43 . S THDR=""
44 . F AI=1:1:$L(SDSCDVSL,",") S SDSCDIV=$P(SDSCDVSL,",",AI) Q:SDSCDIV="" D Q:$G(SDABRT)=1
45 .. S SDSCDNM=$P(^DG(40.8,SDSCDIV,0),"^",1),THDR=THDR_SDSCDNM_",",CT=CT+1 D BLD
46 G EXT
47 ;
48BLD ;
49 N SDOEDT,ATOTAL,ENC,SDOE0,TOTAL,EDIV,SDEFLG,SI,SUBTOT,SDNWPV,DIV
50 N SBTOT,SDOE,SDSCDATA,SCVAL
51 I WHO="A" S SDOEDT=SDSCTDT,ATOTAL=0 D
52 . I '$D(ZTQUEUED) D EN^DDIOL("Please wait while I count encounters")
53 . F S SDOEDT=$O(^SCE("B",SDOEDT)) Q:SDOEDT\1>SDEDT!(SDOEDT="") D
54 .. S ENC="" F S ENC=$O(^SCE("B",SDOEDT,ENC)) Q:ENC="" D
55 ... S SDOE0=$$GETOE^SDOE(ENC,0)
56 ... I SDSCDIV'="" Q:$P(SDOE0,U,11)'=SDSCDIV
57 ... I $P(SDOE0,U,12)=2 S ATOTAL=ATOTAL+1 I '$D(ZTQUEUED) W:ATOTAL#100=0 "."
58 ;
59FND ;
60 S SDOEDT=SDSCTDT,TOTAL=0
61 F S SDOEDT=$O(^SDSC(409.48,"AE",SDOEDT)) Q:SDOEDT\1>SDEDT!(SDOEDT="") D
62 . S SDOE=""
63 . F S SDOE=$O(^SDSC(409.48,"AE",SDOEDT,SDOE)) Q:SDOE="" D
64 .. I SDSCDIV'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
65 .. S EDIV=$P(^SDSC(409.48,SDOE,0),U,12),TOTAL=TOTAL+1
66 .. ; if division is null, check for value
67 .. I EDIV="" D
68 ... S EDIV=$P($G(^SCE(SDOE,0)),U,11)
69 ... I EDIV="" S EDIV="~" Q
70 ... D UPD(SDOE,.12,EDIV,"I")
71 .. ; Check for not editable
72 .. S SDEFLG=0 D CHECK^SDSCEDT
73 .. I 'SDEFLG D STORE("NOT") W "!X" Q
74 .. S SDSCDATA=$G(^SDSC(409.48,SDOE,0)) I SDSCDATA="" Q
75 .. I +$P(SDSCDATA,U,9),+$P(SDSCDATA,U,6) D STORE("VBA") Q
76 .. I $P(SDSCDATA,U,5)="R" D STORE("REV") Q
77 .. I $P(SDSCDATA,U,5)="C" S SCVAL=$$SCHNG^SDSCUTL(SDOE) D:SCVAL'=""
78 ...I '+SCVAL D STORE("NO CHANGE") Q
79 ...I $P(SCVAL,"^",2) D STORE("SCNSC") Q
80 ...D STORE("NSCSC")
81 ;
82PRT ; Print report
83 S SUBTOT=0
84 S SDHDR="Managers Summary Data Report"
85 U IO D STDHDR^SDSCRPT2 Q:$G(SDABRT)=1
86 S SDNWPV=1
87 W SDHDR,?67,"PAGE: ",P
88 W !,?5,"For Encounters Dated ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)," For Division: ",SDSCDNM,!!
89 W ! F I=1:1:79 W "-"
90 ;
91 I WHO="A" W !,"All Checked Out Encounters: ",?52,$J(ATOTAL,10) S DATOTAL=DATOTAL+ATOTAL
92 W !,"ASCD Encounters that are potentially billable: ",?55,$J(TOTAL,7) S DTOTAL=DTOTAL+TOTAL
93 W !,?55,$J("-------",7)
94 S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"VBA",DIV)) Q:DIV="" D
95 . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"VBA",DIV)
96 W !,"Encounters verified with Rated Disability Codes: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("VBA")=DTOT("VBA")+SBTOT
97 S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"NO CHANGE",DIV)) Q:DIV="" D
98 . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"NO CHANGE",DIV)
99 W !,"Encounters where SC NOT changed: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("NO CHANGE")=DTOT("NO CHANGE")+SBTOT
100 S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"SCNSC",DIV)) Q:DIV="" D
101 . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"SCNSC",DIV)
102 W !,"Encounters where SC was changed to NSC: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("SCNSC")=DTOT("SCNSC")+SBTOT
103 S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"NSCSC",DIV)) Q:DIV="" D
104 . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"NSCSC",DIV)
105 W !,"Encounters where NSC was changed to SC: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("NSCSC")=DTOT("NSCSC")+SBTOT
106 S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"REV",DIV)) Q:DIV="" D
107 . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"REV",DIV)
108 W !,"Encounters sent to Clinical Review: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("REV")=DTOT("REV")+SBTOT
109 S SBTOT=0,DIV="" F S DIV=$O(^TMP("SDSCMGR",$J,"NOT",DIV)) Q:DIV="" D
110 . S SBTOT=SBTOT+^TMP("SDSCMGR",$J,"NOT",DIV)
111 W !,"Encounters not editable: ",?55,$J(SBTOT,7) S SUBTOT=SUBTOT+SBTOT,DTOT("NOT")=DTOT("NOT")+SBTOT
112 W !,"Encounters not yet processed: ",?55,$J(TOTAL-SUBTOT,7) S DTOT("NPROC")=DTOT("NPROC")+(TOTAL-SUBTOT)
113 W !!!
114 K ^TMP("SDSCMGR",$J)
115 Q
116 ;
117UPD(SDENC,SDFLD,SDVAL,SDFLG) ; Update record
118 N SDPD
119 S SDPD(409.48,SDENC_",",SDFLD)=SDVAL
120 D FILE^DIE(SDFLG,"SDPD","ERROR")
121 Q
122EXT ;
123 I CT>1,$G(SDABRT)'=1 D PRTT
124 D RPTEND^SDSCRPT1
125 ;
126EXIT ;
127 K SDTYPE,SDSCTDT,SDEDT,SDSCEDT,SCLN,DIRUT,DTOUT,DUOUT,SDHDR
128 K SDSCMSG,SDFLG,SDOEDAT,SDOSC,SDPAT,SDSCPKG,SDSCSRC,SDV0
129 Q
130STORE(VAL) ; Total up and Store
131 S ^TMP("SDSCMGR",$J,VAL,EDIV)=$G(^TMP("SDSCMGR",$J,VAL,EDIV))+1
132 S ^TMP("SDSCMGR",$J,VAL,EDIV,SDOE)=""
133 K VAL
134 Q
135 ;
136PRTT ; Print total page
137 N HHDR,HHDR1,HHDR2,HHDR3,HHDR4,I
138 U IO D STDHDR^SDSCRPT2 Q:$G(SDABRT)=1
139 I $E(THDR,$L(THDR))="," S THDR=$E(THDR,1,$L(THDR)-1)
140 W SDHDR,?67,"PAGE: ",P
141 S HHDR1="For Encounters Dated "_$$FMTE^XLFDT(SDSCTDT,2)_" THRU "_$$FMTE^XLFDT(SDEDT,2)_" TOTAL for "
142 S HHDR2=THDR
143 I $L(HHDR1)+$L(HHDR2)>IOM D
144 . S HHDR3=$P(HHDR2,",",1),HHDR4=$P(HHDR2,",",2,99)
145 . S HHDR=HHDR1_HHDR3
146 . I HHDR4'="" S HHDR=HHDR_","
147 I $L(HHDR1)+$L(HHDR2)'>IOM D
148 . S HHDR=HHDR1_HHDR2
149 W !,HHDR
150 I $G(HHDR4)'="" W !,?5,HHDR4
151 W ! F I=1:1:79 W "-"
152 ;
153 I WHO="A" W !,"All Checked Out Encounters: ",?52,$J(DATOTAL,10)
154 W !,"ASCD Encounters w/ SC='Yes' & potentially billable: ",?55,$J(DTOTAL,7)
155 W !,?55,$J("-------",7)
156 W !,"Encounters verified with Rated Disability Codes: ",?55,$J(DTOT("VBA"),7)
157 W !,"Encounters where SC NOT changed: ",?55,$J(DTOT("NO CHANGE"),7)
158 W !,"Encounters where SC was changed to NSC: ",?55,$J(DTOT("SCNSC"),7)
159 W !,"Encounters where NSC was changed to SC: ",?55,$J(DTOT("NSCSC"),7)
160 W !,"Encounters sent to Clinical Review: ",?55,$J(DTOT("REV"),7)
161 W !,"Encounters not editable: ",?55,$J(DTOT("NOT"),7)
162 W !,"Encounters not yet processed: ",?55,$J(DTOT("NPROC"),7)
163 W !!!
164 Q
Note: See TracBrowser for help on using the repository browser.