source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCDXPOV1.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: 4.3 KB
Line 
1SCDXPOV1 ;ALB/SCK - VISIT REPORT BY NPCDB TRANSMISSION STATUS ;11/29/99 19:23
2 ;;5.3;Scheduling;**73,173**;AUG 13, 1993
3 Q
4WRT ; Entry point for printing visit reprot
5 ;
6 ; Variables:
7 ; DVN - Division IEN used in VA(389.9, and DG(40.8 for retreiving division name
8 ; DNAME - Division name for printing on report
9 ; SDASH - Single dash line for report formatting
10 ; SDBDASH - Double dash line for report formatting
11 ; SCETOT - Total encounters, Eligibility
12 ;
13 N DVN,DNAME,SDASH,SDBDASH,SDNM,SCETOT
14 S $P(SDASH,"-",40)="",$P(SDBDASH,"=",76)=""
15 ;
16 U IO
17 I 'SCXMD D G END
18 . S DVN=$P($$SITE^VASITE(SCXBEG),U,3),DNAME=$P($$SITE^VASITE(SCXBEG),U,2)
19 . D XMTPRT
20 ;
21 I SCXTFLG D G END
22 . S DVN="TOT",DNAME="FACILITY TOTALS: "_$P($$SITE^VASITE(SCXBEG),U,2)
23 . D XMTPRT
24 ;
25 S DVN=0
26 F S DVN=$O(^TMP("SCDXPOV",$J,DVN)) Q:DVN="" S:DVN'["TOT" SDNM=$O(^VA(389.9,"D",DVN,0)),DNAME=+$P(^VA(389.9,SDNM,0),U,3) D Q:SCXABRT
27 . S DNAME=$S('DNAME:"UNKNOWN "_DVN,'$D(^DG(40.8,DNAME,0)):"UNKNOWN",1:$P(^DG(40.8,DNAME,0),U))
28 . S:DVN["TOT" DNAME="FACILITY TOTALS: "_$P($$SITE^VASITE(SCXBEG),U,2)
29 . D XMTPRT
30END Q
31 ;
32XMTPRT ; Print data for visit report
33 ;
34 ; Variables
35 ; NUM, LL1 - Local counters
36 ; SBTT - Track subtotals for each category
37 ; LL - Temporary holder for encounter status values
38 ;
39 N LL,SBTT,LL1,NUM,SCETOT
40 ;
41 D HDR1
42 ;
43 W !,?5,"VETERAN ELIGIBILITY",!
44 K SBTT,LL
45 S NUM=0
46 F S NUM=$O(^TMP("SCDXPOV",$J,DVN,"VELIG",NUM)) Q:'NUM D I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
47 . S LL=^TMP("SCDXPOV",$J,DVN,"VELIG",NUM)
48 . W !?8,$P(^DIC(8,NUM,0),U),?40,$J(+$P(LL,U,1),6),?51,$J(+$P(LL,U,2),6),?65,$J(+$P(LL,U,3),6)
49 . F LL1=1:1:3 S SBTT(LL1)=+$G(SBTT(LL1))+$P(LL,U,LL1)
50 ;
51 W !?38,SDASH,!,?5,"Veteran Sub-Total",?40,$J(SBTT(1),6),?51,$J(SBTT(2),6),?65,$J(SBTT(3),6)
52 F LL1=1:1:3 S SCETOT(LL1)=+$G(SCETOT(LL1))+$G(SBTT(LL1))
53 I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
54 ;
55 W !!,?5,"NON-VETERAN ELIGIBILITY",!
56 K SBTT,LL
57 S NUM=0
58 F S NUM=$O(^TMP("SCDXPOV",$J,DVN,"NVELIG",NUM)) Q:'NUM D I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
59 . S LL=^TMP("SCDXPOV",$J,DVN,"NVELIG",NUM)
60 . W !?8,$P(^DIC(8,NUM,0),U),?40,$J(+$P(LL,U,1),6),?51,$J(+$P(LL,U,2),6),?65,$J(+$P(LL,U,3),6)
61 . F LL1=1:1:3 S SBTT(LL1)=+$G(SBTT(LL1))+$P(LL,U,LL1)
62 ;
63 W !?38,SDASH,!,?5,"Non-Veteran Sub-Total",?40,$J(SBTT(1),6),?51,$J(SBTT(2),6),?65,$J(SBTT(3),6)
64 F LL1=1:1:3 S SCETOT(LL1)=+$G(SCETOT(LL1))+$G(SBTT(LL1))
65 I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
66 ;
67 W !!,?5,"CATEGORY OF VISIT",!
68 K SBTT,LL
69 S NUM=0
70 F S NUM=$O(^TMP("SCDXPOV",$J,DVN,"COV",NUM)) Q:'NUM D I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
71 . S LL=^TMP("SCDXPOV",$J,DVN,"COV",NUM)
72 . W !?8,$P($T(VISIT+NUM),";",3),?40,$J($P(LL,U,1),6),?51,$J($P(LL,U,2),6),?65,$J($P(LL,U,3),6)
73 . F LL1=1:1:3 S SBTT(LL1)=+$G(SBTT(LL1))+$P(LL,U,LL1)
74 ;
75 W !?38,SDASH,!,?5,"Category Sub-Total",?40,$J(SBTT(1),6),?51,$J(SBTT(2),6),?65,$J(SBTT(3),6)
76 I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
77 ;
78 W !!?2,SDBDASH,!?5,$S(DNAME["FACILITY":"Facility Total",1:"Total for "_$E(DNAME,1,25))_":",?40,$J(SCETOT(1),6),?51,$J(SCETOT(2),6),?65,$J(SCETOT(3),6)
79 W !?16,"Total: ",SCETOT(1)+SCETOT(2)+SCETOT(3)
80 I $Y>(IOSL-8) D NEWPAGE G:SCXABRT XMTQ
81 ;
82 W !!,?8,"Compensation and Pension appointments are included in the above",!?8,"categories and totals and are shown here for information only"
83 K LL S LL=^TMP("SCDXPOV",$J,DVN,"CP")
84 W !!?8,"COMPENSATION AND PENSION",?40,$J($P(LL,U,1),6),?51,$J($P(LL,U,2),6),?65,$J($P(LL,U,3),6)
85 ;
86 I SCXOPT>1&(IOST?1"C-".E) K LL W !," Press RETURN to continue or '^' to exit: " R LL:DTIME S SCXABRT='$T!(LL="^")
87 ;
88XMTQ Q
89 ;
90HDR1 ; Print report header and column headers
91 N HD2,HD1
92 W @IOF
93 S HD1="ENCOUNTER REPORT BY TRANSMISSION STATUS TO NPCDB"
94 W !?(IOM-$L(HD1))/2,"ENCOUNTER REPORT BY TRANSMISSION STATUS TO NPCDB"
95 S HD2="FOR PERIOD "
96 S Y=SCXBEG D DTS^SDUTL
97 S HD2=HD2_Y_" THRU "
98 S Y=SCXEND D DTS^SDUTL
99 S HD2=HD2_Y
100 W !?2,DNAME,$S(DVN'["TOT"&SCXMD:" DIVISION",1:""),?(IOM-$L(HD2))-5,HD2
101 W !!,?54,"ENCOUNTERS",!?38,SDASH
102 W !?40,"WAITING",?51,"TRANSMITTED",?65,"ACKNOWLEDGED"
103 W !?2,SDBDASH
104 Q
105 ;
106NEWPAGE ;
107 I IOST?1"C-".E S DIR(0)="E" D ^DIR S SCXABRT='+$G(Y) D CLEAR^SCDXPOV2
108 I 'SCXABRT D HDR1
109 Q
110 ;
111VISIT ; Category of visits Displayed value/Stored value
112 ;;SCHEDULED VISIT;APPOINTMENT
113 ;;UNSCHEDULED VISIT;STOP CODE ADDITION
114 ;;10 - 10;DISPOSITION
Note: See TracBrowser for help on using the repository browser.