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