1 | SPNPRT01 ;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 | ;
|
---|
5 | EN1 ; 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
|
---|
13 | EXIT ; Exit routine
|
---|
14 | K SPNLEXIT,SPNIO,SPNPAGE
|
---|
15 | K ^TMP($J,"SPN"),^TMP($J,"SPNPRT","AUTO"),^TMP($J,"SPNPRT","POST")
|
---|
16 | Q
|
---|
17 | PRINT ; 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
|
---|
60 | HEAD ; 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
|
---|