source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPRT01.m@ 623

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1SPNPRT01 ;HIRMFO/WAA- PRINT Mailing Labels ; 8/21/96
2 ;;2.0;Spinal Cord Dysfunction;**11,15**;01/02/1997
3 ;This routine is to store mailing labels into a file.
4 ;
5EN1 ; Main Entry Point
6 N SPNLEXIT,SPNIO,SPNPAGE S SPNPAGE=1
7 S SPNLEXIT=0 D EN1^SPNPRTMT Q:SPNLEXIT ;Filters
8 S ZTSAVE("SPN*")=""
9 D DEVICE^SPNPRTMT("PRINT^SPNPRT01","SCD Mailing Labels",.ZTSAVE) Q:SPNLEXIT
10 I SPNIO="Q" D EXIT Q ; Print was Queued
11 I IO'="" D PRINT D EXIT Q ; Print was not Queued
12 Q
13EXIT ; Exit routine
14 K SPNLEXIT,SPNIO,SPNPAGE
15 K ^TMP($J,"SPN"),^TMP($J,"SPNPRT","AUTO"),^TMP($J,"SPNPRT","POST")
16 Q
17PRINT ; Print main Body
18 U IO
19 S SPNLEXIT=$G(SPNLEXIT) ; Ensure that exit is set; **MOD CM/SD ,0
20 N SPNDFN,SPNX
21 I $E(IOST,1)="C" D Q:SPNLEXIT
22 .W !,"Prepare to capture list: Hit return when you are ready: "
23 .W !,"When you see ---END--- Close the capture file and hit return."
24 .R !,SPNX:DTIME I '$T S SPNX="^"
25 .I SPNX="^" S SPNLEXIT=1 Q
26 .Q
27 ;W "NAME,ADDRESS1,ADDRESS2,ADDRESS3,CITY,STATE,ZIPCODE"
28 W "FNAME,LNAME,ADDRESS1,ADDRESS2,ADDRESS3,CITY,STATE,ZIPCODE"
29 S (SPNDFN,SPNLPRT)=0
30 F S SPNDFN=$O(^SPNL(154,SPNDFN)) Q:SPNDFN<1 D Q:SPNLEXIT
31 . N LINE,SPNPRT
32 . S SPNPRT=0
33 . Q:SPNLEXIT
34 . Q:$G(^SPNL(154,SPNDFN,0))="" ; No Zero node
35 . I $L($$GET1^DIQ(2,SPNDFN_",",.351)) Q ;Patient has passed on WDE
36 . Q:$P(^SPNL(154,SPNDFN,0),"^",3)="X" ; **MOD CM/SD No expired pts
37 . I '$$EN2^SPNPRTMT(SPNDFN) Q ; Patient fail the filters
38 . S SPNLPRT=1 ; Indicates the report had data
39 . S DFN=SPNDFN D ^VADPT
40 . ;S LINE=""_$P(VADM(1),",",2)_" "_$P(VADM(1),",",1)_"" ; **MOD CM/SD
41 . S LINE=""_$P($P(VADM(1),",",2)," ",1)_"" ; first name
42 . S LINE=LINE_","_$P(VADM(1),",",1) ; last name
43 . S DFN=SPNDFN D ADD^VADPT
44 . I VAPA(1)=""!(VAPA(4)="")!($P(VAPA(5),U,2)="")!(VAPA(6)="") S SPNPRT=1
45 . F I=1:1:4 D
46 .. S:VAPA(I)["," VAPA(I)=""""_VAPA(I)_""""
47 .. S LINE=LINE_","_VAPA(I)
48 .. Q
49 . S LINE=$S($P(VAPA(5),U,1)'="":LINE_","_$P($G(^DIC(5,$P(VAPA(5),U,1),0)),U,2),1:LINE_","_"UNKNOWN") ; **MOD CM/SD STATE
50 . S LINE=LINE_","_VAPA(6)
51 . I 'SPNPRT W !,LINE
52 . D KVAR^VADPT
53 . Q
54 I 'SPNLPRT W !," ******* No Data for this report. *******"
55 I $E(IOST,1)="C" D
56 .R !,"---END---",SPNX:DTIME
57 .Q
58 D CLOSE^SPNPRTMT
59 Q
60HEAD ; Header Print
61 I SPNPAGE'=1 Q:$Y<(IOSL-4)
62 I $E(IOST,1)="C" D Q:SPNLEXIT
63 .I SPNPAGE=1 W @IOF Q
64 .I SPNPAGE'=1 D Q:SPNLEXIT
65 ..N DIR S DIR(0)="E" D ^DIR I 'Y S SPNLEXIT=1
66 ..K Y
67 ..Q
68 .Q
69 Q:SPNLEXIT
70 I SPNPAGE'=1 W @IOF
71 S SPNPAGE=SPNPAGE+1
72 I $D(ZTQUEUED) S:$$STPCK^SPNPRTMT SPNLEXIT=1
73 Q
Note: See TracBrowser for help on using the repository browser.