source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPRT09.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1SPNPRT09 ;HIRMFO/WAA- PRINT Application for Disp. ;10/25/96 11:30
2 ;;2.0;Spinal Cord Dysfunction;**12**;01/02/1997
3 ;;
4EN1 ; Main Entry Point
5 N SPNLEXIT,SPNIO,SPNPAGE,SPNDATE,SPNEDAT S SPNPAGE=1
6 S SPNLEXIT=0
7 W !!,"Report Filter: "
8 S SPNA=" Enter START Date: "
9 S SPNQ=" Enter the earliest date of Application for the print to START with."
10 D QUEST^SPNPRT04("DA^:NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
11 S SPNDATE=Y
12 S ZTSAVE("SPN*")=""
13 S SPNA=" Enter END Date: "
14 S SPNQ=" Enter the latest date of Application for the print to END with."
15 D QUEST^SPNPRT04("DA^"_SPNDATE_":NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
16 S SPNEDAT=Y
17 D DEVICE^SPNPRTMT("PRINT^SPNPRT09","Application for SCI/SCD Discharges",.ZTSAVE) Q:SPNLEXIT
18 I SPNIO="Q" D EXIT Q ; Print was Queued
19 I IO'="" D PRINT D EXIT Q ; Print was not Queued
20 Q
21EXIT ; Exit routine
22 K ^TMP($J,"SPN"),^TMP($J,"SPNPRT","AUTO"),^TMP($J,"SPNPRT","POST")
23 K SPNDATE
24 Q
25PRINT ; Print main Body
26 U IO
27 K ^TMP($J,"SPN")
28 S SPNLEXIT=$G(SPNLEXIT,0) ; Ensure that the exit is set
29 N SPNDFN,SPNX,SPNFAC
30 S (SPNDFN,SPNLPRT,SPNFAC)=0
31 S SPNQDAT=SPNDATE-.000001
32 Q:SPNLEXIT
33 F S SPNQDAT=$O(^DPT("ADIS",SPNQDAT)) Q:(SPNQDAT<1) Q:(SPNQDAT>SPNEDAT) D Q:SPNLEXIT
34 . S SPNDFN=0
35 . F S SPNDFN=$O(^DPT("ADIS",SPNQDAT,SPNDFN)) Q:SPNDFN<1 D Q:SPNLEXIT
36 .. Q:'$D(^SPNL(154,SPNDFN,0)) ; Patient is not in SCD Registry
37 .. S ^TMP($J,"SPN",$$GET1^DIQ(2,SPNDFN,.01,"E"),SPNDFN)=""
38 .. Q
39 . Q
40 I $D(^TMP($J,"SPN")) D Q:SPNLEXIT ; Indicates the report had data
41 . N SPNSTATE,SPNDFN,SPNNAME,SPNCOU
42 . S SPNCOU=0
43 . S SPNNAME="" F S SPNNAME=$O(^TMP($J,"SPN",SPNNAME)) Q:SPNNAME="" D Q:SPNLEXIT
44 .. S SPNDFN=0 F S SPNDFN=$O(^TMP($J,"SPN",SPNNAME,SPNDFN)) Q:SPNDFN<1 D Q:SPNLEXIT
45 ... D HEAD Q:SPNLEXIT
46 ... D PATIENT(SPNDFN) Q:SPNLEXIT
47 ... W !
48 ... Q
49 .. Q
50 . I SPNCOU W !,?15,SPNCOU," Patients have been processed."
51 . Q
52 E W !," ******* No Data for this report. *******"
53 I $E(IOST,1)="C" N DIR S DIR(0)="E" D ^DIR K Y
54 D CLOSE^SPNPRTMT
55 K ^TMP($J,"SPN")
56 Q
57PATIENT(SPNDFN) ; Print Patient data
58 Q:SPNLEXIT
59 N DFN
60 S DFN=SPNDFN
61 D DEM^VADPT
62 W !,$E(VADM(1),1,30)," (",$E(VADM(1),1),VA("BID"),")"
63 D KVAR^VADPT
64 K ^UTILITY("VARP",$J)
65 S DFN=SPNDFN,VARP("F")=SPNDATE,VARP("T")=SPNEDAT
66 D REG^VADPT
67 N SPNODE,SPNNODE
68 S SPNODE=0
69 F S SPNODE=$O(^UTILITY("VARP",$J,SPNODE)) Q:SPNODE<1 D Q:SPNLEXIT
70 .N SPNX,SPNY
71 .S SPNX=$G(^UTILITY("VARP",$J,SPNODE,"I")) Q:SPNX=""
72 .S SPNY=$G(^UTILITY("VARP",$J,SPNODE,"E")) Q:SPNY=""
73 .I $X>40 D HEAD Q:SPNLEXIT W !
74 .W ?40,$$FMTE^XLFDT($P(SPNX,U),"2D"),?50,$E($P(SPNY,U,7),1,29)
75 .I $P(SPNY,U,3)'="" W !,?33,"TYPE OF BENEFIT: ",$E($P(SPNY,U,3),1,29)
76 .Q
77 D KVAR^VADPT K ^UTILITY("VARP",$J)
78 Q
79HEAD ; Header Print
80 I SPNPAGE'=1 Q:$Y<(IOSL-4)
81 I $E(IOST,1)="C" D Q:SPNLEXIT
82 .I SPNPAGE=1 W @IOF Q
83 .I SPNPAGE'=1 D Q:SPNLEXIT
84 ..N DIR S DIR(0)="E" D ^DIR I 'Y S SPNLEXIT=1
85 ..K Y
86 ..Q
87 .Q
88 Q:SPNLEXIT
89 I SPNPAGE'=1 W @IOF
90 W !,$$FMTE^XLFDT($$NOW^XLFDT,1),?70,"Page: ",SPNPAGE
91 W !!,?30,"Applications for Inpatient Care"
92 W !,?32,"From: ",$$FMTE^XLFDT(SPNDATE,"2D")," to: ",$$FMTE^XLFDT(SPNEDAT,"2D")
93 W !!,?40,"Date of"
94 W !,"Patient",?40,"Dispos.",?50,"Disposition"
95 W !,$$REPEAT^XLFSTR("-",79)
96 S SPNPAGE=SPNPAGE+1
97 I $D(ZTQUEUED) S:$$STPCK^SPNPRTMT SPNLEXIT=1
98 Q
Note: See TracBrowser for help on using the repository browser.