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