source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDSCPRV.m@ 1267

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1SDSCPRV ;ALB/JAM/RBS - ASCD Provider Total Report ; 1/19/07 12:46pm
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 gives a total of the number of encounters that meet
8 ; the criteria: SC='Yes', auto-verified, and changed
9 Q
10EN ; Entry Point
11 N DIR,SDSCDVSL,SDSCDVLN,X,Y,ZTQUEUED,POP,ZTRTN,ZTDTH,ZTDESC,ZTSAVE
12 ; Get Divisions
13 D DIV^SDSCUTL
14 D ^DIR
15 I $G(DTOUT)!($G(DUOUT)) G EXIT
16 S SDSCDVSL=Y,SDSCDVLN=SCLN
17 ; Get start and end date for report
18 D GETDATE^SDSCOMP I SDSCTDT="" G EXIT
19 K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP EXIT
20 I $D(IO("Q")) D G EXIT
21 . S ZTRTN="BEG^SDSCPRV",ZTDTH=$H,ZTDESC="ASCD Provider Total Report"
22 . S ZTSAVE("SDSCBDT")="",ZTSAVE("SDSCEDT")="",ZTSAVE("SDSCDVSL")=""
23 . S ZTSAVE("SDSCDVLN")="",ZTSAVE("GROUP")="",ZTSAVE("SDEDT")="",ZTSAVE("SDSCTDT")=""
24 . K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED"
25 ;
26BEG ; Begin report
27 N P,L,SDABRT,CT,SDSCDIV,SDSCDNM,THDR,SDI
28 S (P,L,SDABRT,CT)=0
29 S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:SDSCDVSL,1:"")
30 I SDSCDIV="" S SDSCDNM="ALL" D FND G EXT
31 I SDSCDIV'="" D
32 . S THDR=""
33 . F SDI=1:1:$L(SDSCDVSL,",") S SDSCDIV=$P(SDSCDVSL,",",SDI) Q:SDSCDIV="" D Q:$G(SDABRT)=1
34 .. S SDSCDNM=$P(^DG(40.8,SDSCDIV,0),"^",1),THDR=THDR_SDSCDNM_",",CT=CT+1 D FND
35 G EXT
36 ;
37FND ;
38 N SDPROV,SDOEDT,SDPRNM,SDOE,SDSCDATA,TOTAL,TYP,LEV1,COL,AMT,SCVAL
39 K ^TMP("SDSCPRV",$J)
40 S SDPROV=0
41 F S SDPROV=$O(^SDSC(409.48,"AF",SDPROV)) Q:'SDPROV D
42 . S SDOEDT=SDSCTDT,SDPRNM=$$UP^XLFSTR($$NAME^XUSER(SDPROV,"F"))
43 . F S SDOEDT=$O(^SDSC(409.48,"AF",SDPROV,SDOEDT)) Q:SDOEDT\1>SDEDT!(SDOEDT="") D
44 .. S SDOE=""
45 .. F S SDOE=$O(^SDSC(409.48,"AF",SDPROV,SDOEDT,SDOE)) Q:'SDOE D
46 ... I SDSCDIV'="" Q:$P(^SDSC(409.48,SDOE,0),U,12)'=SDSCDIV
47 ... S SDSCDATA=^SDSC(409.48,SDOE,0)
48 ... I +$P(SDSCDATA,U,9),+$P(SDSCDATA,U,6) D STORE("VBA") Q
49 ... I $P(SDSCDATA,U,5)="C" S SCVAL=$$SCHNG^SDSCUTL(SDOE) D:SCVAL'="" Q
50 ....I '+SCVAL D STORE("NO CHANGE") Q
51 ....I $P(SCVAL,"^",2) D STORE("SCNSC") Q
52 ....D STORE("NSCSC")
53 ... D STORE("NEW")
54 ;
55PRT ; Print
56 K TOTAL
57 S SDHDR="Provider Summary Data Report"
58 D HDR G EXT:$G(SDABRT)=1
59 F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S TOTAL(TYP)=0
60 S LEV1=""
61 F S LEV1=$O(^TMP("SDSCPRV",$J,LEV1)) Q:LEV1="" D Q:$G(SDABRT)=1
62 . I L+4>IOSL D HDR Q:$G(SDABRT)=1
63 . W !,LEV1 S L=L+1
64 . S COL=20 F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S COL=COL+10 D
65 .. S AMT=+$G(^TMP("SDSCPRV",$J,LEV1,TYP)),SBTOT(LEV1,TYP)=$G(SBTOT(LEV1,TYP))+AMT,TOTAL(TYP)=$G(TOTAL(TYP))+AMT
66 .. W ?COL,$J(AMT,7)
67 I $G(SDABRT)=1 Q
68 S COL=20,L=L+1 W ! I L+4>IOSL D HDR Q:$G(SDABRT)=1
69 F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S COL=COL+10 D
70 . W ?COL,"-------"
71 S COL=20,L=L+1 W !,"TOTAL"
72 F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S COL=COL+10 D
73 . W ?COL,$J($G(TOTAL(TYP)),7)
74 Q
75 ;
76EXT ;
77 I CT>1,$G(SDABRT)'=1 D PRTT
78 D RPTEND^SDSCRPT1
79 ;
80EXIT ;
81 K SDNWPV,SDSCBDT,SDSCEDT,EDIV,GROUP,SDSCTDT,SDEDT,I,Y,^TMP("SDSCPRV",$J)
82 K SDHDR,SCLN,DTOUT,DUOUT,SBTOT,TOTAL
83 Q
84STORE(VAL) ; Total up and Store
85 S ^TMP("SDSCPRV",$J,SDPRNM,VAL)=$G(^TMP("SDSCPRV",$J,SDPRNM,VAL))+1
86 S ^TMP("SDSCPRV",$J,SDPRNM,VAL,SDOE)=""
87 K VAL
88 Q
89HDR ; Header
90 U IO D STDHDR^SDSCRPT2 Q:$G(SDABRT)=1
91 S SDNWPV=1
92 W SDHDR,?67,"PAGE: ",P
93 W !,?5,"For Encounters Dated ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)_" By Division: "_SDSCDNM
94 W !?31," VBA OK",?40,"SC to NSC",?51,"NSC to SC",?62,"SC KEPT",?74,"NEW",!
95 F I=1:1:79 W "-"
96 Q
97 ;
98HDR1 ;
99 N HHDR,HHDR1,HHDR2,HHDR3,HHDR4,I
100 U IO D STDHDR^SDSCRPT2 Q:$G(SDABRT)=1
101 I $E(THDR,$L(THDR))="," S THDR=$E(THDR,1,$L(THDR)-1)
102 W SDHDR,?67,"PAGE: ",P
103 S HHDR1="For Encounters Dated "_$$FMTE^XLFDT(SDSCTDT,2)_" THRU "_$$FMTE^XLFDT(SDEDT,2)_" TOTAL for "
104 S HHDR2=THDR
105 I $L(HHDR1)+$L(HHDR2)>IOM D
106 . S HHDR3=$P(HHDR2,",",1),HHDR4=$P(HHDR2,",",2,99)
107 . S HHDR=HHDR1_HHDR3
108 . I HHDR4'="" S HHDR=HHDR_","
109 I $L(HHDR1)+$L(HHDR2)'>IOM D
110 . S HHDR=HHDR1_HHDR2
111 W !,HHDR
112 I $G(HHDR4)'="" W !,?5,HHDR4
113 W !?31," VBA OK",?40,"SC to NSC",?51,"NSC to SC",?62,"SC KEPT",?74,"NEW",!
114 F I=1:1:79 W "-"
115 Q
116 ;
117PRTT ;
118 D HDR1 Q:$G(SDABRT)=1
119 F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S TOTAL(TYP)=0
120 S LEV1=""
121 F S LEV1=$O(SBTOT(LEV1)) Q:LEV1="" D
122 . I L+4>IOSL D HDR1 Q:$G(SDABRT)=1
123 . W !,LEV1 S L=L+1
124 . S COL=20 F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S COL=COL+10 D
125 .. S AMT=SBTOT(LEV1,TYP),TOTAL(TYP)=$G(TOTAL(TYP))+AMT
126 .. W ?COL,$J(AMT,7)
127 S COL=20,L=L+1 W ! I L+4>IOSL D HDR1 Q:$G(SDABRT)=1
128 F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S COL=COL+10 D
129 . W ?COL,"-------"
130 S COL=20,L=L+1 W !,"TOTAL"
131 F TYP="VBA","SCNSC","NSCSC","NO CHANGE","NEW" S COL=COL+10 D
132 . W ?COL,$J($G(TOTAL(TYP)),7)
133 Q
Note: See TracBrowser for help on using the repository browser.