| 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 | 
|---|