[628] | 1 | SPNPRT04 ;HIRMFO/WAA- PRINT New SCD/SCI Registrant ;8/29/96 15:41
|
---|
| 2 | ;;2.0;Spinal Cord Dysfunction;**12**;01/02/1997
|
---|
| 3 | ;;
|
---|
| 4 | EN1 ; Main Entry Point
|
---|
| 5 | N SPNLEXIT,SPNIO,SPNPAGE,SPNDATE S SPNPAGE=1
|
---|
| 6 | S SPNLEXIT=0 D EN1^SPNPRTMT Q:SPNLEXIT ;Filters
|
---|
| 7 | W !!,"Report Filter: "
|
---|
| 8 | S SPNA=" Enter Original Registration START Date: "
|
---|
| 9 | S SPNQ=" Enter the earliest date of original registration for the print to START with."
|
---|
| 10 | D QUEST("DA^:NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
|
---|
| 11 | S SPNDATE=Y
|
---|
| 12 | S ZTSAVE("SPN*")=""
|
---|
| 13 | S SPNA=" Enter Original Registration END Date: "
|
---|
| 14 | S SPNQ=" Enter the Last date of original registration for the print to END with."
|
---|
| 15 | D QUEST("DA^"_SPNDATE_":NOW:EP",SPNA,SPNQ) Q:SPNLEXIT
|
---|
| 16 | S SPNEDAT=Y
|
---|
| 17 | D DEVICE^SPNPRTMT("PRINT^SPNPRT04","SCD New Patient Registrants",.ZTSAVE) Q:SPNLEXIT
|
---|
| 18 | I SPNIO="Q" D EXIT Q ; Print was Queued
|
---|
| 19 | I IO'="" D PRINT D EXIT Q ; Print was not Queued
|
---|
| 20 | Q
|
---|
| 21 | QUEST(SPNX,SPNA,SPNQ) ; Report Question
|
---|
| 22 | N DIR
|
---|
| 23 | S DIR(0)=SPNX
|
---|
| 24 | S DIR("A")=SPNA
|
---|
| 25 | S DIR("?")=SPNQ
|
---|
| 26 | D ^DIR
|
---|
| 27 | I $D(DIRUT) S SPNLEXIT=1 W !,"Print Aborted!" Q
|
---|
| 28 | Q
|
---|
| 29 | EXIT ; Exit routine
|
---|
| 30 | K SPNLEXIT,SPNIO,SPNPAGE,SPNDATE
|
---|
| 31 | K ^TMP($J,"SPN"),^TMP($J,"SPNPRT","AUTO"),^TMP($J,"SPNPRT","POST")
|
---|
| 32 | K SPNDATE
|
---|
| 33 | Q
|
---|
| 34 | PRINT ; Print main Body
|
---|
| 35 | U IO
|
---|
| 36 | K ^TMP($J,"SPN")
|
---|
| 37 | S SPNLEXIT=$G(SPNLEXIT,0) ; Ensure that the exit is set
|
---|
| 38 | N SPNDFN,SPNX
|
---|
| 39 | S (SPNDFN,SPNLPRT)=0
|
---|
| 40 | Q:SPNLEXIT
|
---|
| 41 | F S SPNDFN=$O(^SPNL(154,SPNDFN)) Q:SPNDFN<1 D
|
---|
| 42 | . Q:$G(^SPNL(154,SPNDFN,0))="" ; No Zero node
|
---|
| 43 | . I '$$EN2^SPNPRTMT(SPNDFN) Q ; Patient fail the filters
|
---|
| 44 | . S DFN=SPNDFN D DEM^VADPT
|
---|
| 45 | . I $$GET^DDSVAL(154,SPNDFN,.02,"","I")<SPNDATE Q
|
---|
| 46 | . I $$GET^DDSVAL(154,SPNDFN,.02,"","I")>SPNEDAT Q
|
---|
| 47 | . S ^TMP($J,"SPN",VADM(1),SPNDFN)="" ; Sort the data
|
---|
| 48 | . D KVAR^VADPT
|
---|
| 49 | . Q
|
---|
| 50 | I $D(^TMP($J,"SPN")) D Q:SPNLEXIT ; Indicates the report had data
|
---|
| 51 | . N SPNSTATE,SPNDFN,SPNNAME,SPNCOU
|
---|
| 52 | . S SPNCOU=0
|
---|
| 53 | . S SPNNAME="" F S SPNNAME=$O(^TMP($J,"SPN",SPNNAME)) Q:SPNNAME="" D Q:SPNLEXIT
|
---|
| 54 | .. S SPNDFN=0 F S SPNDFN=$O(^TMP($J,"SPN",SPNNAME,SPNDFN)) Q:SPNDFN<1 D Q:SPNLEXIT
|
---|
| 55 | ... D HEAD Q:SPNLEXIT
|
---|
| 56 | ... D PATIENT(SPNDFN) Q:SPNLEXIT
|
---|
| 57 | ... Q
|
---|
| 58 | .. Q
|
---|
| 59 | . W !,?15,SPNCOU," Patients have been processed."
|
---|
| 60 | . Q
|
---|
| 61 | E W !," ******* No Data for this report. *******"
|
---|
| 62 | I $E(IOST,1)="C" N DIR S DIR(0)="E" D ^DIR K Y
|
---|
| 63 | D CLOSE^SPNPRTMT
|
---|
| 64 | K ^TMP($J,"SPN")
|
---|
| 65 | Q
|
---|
| 66 | PATIENT(SPNDFN) ; Print Patient data
|
---|
| 67 | Q:SPNLEXIT
|
---|
| 68 | N SPNETI,SPNZZ
|
---|
| 69 | S DFN=SPNDFN,SPNETI=0
|
---|
| 70 | D DEM^VADPT
|
---|
| 71 | W !,$E(VADM(1),1,18),?20,VA("PID"),?33,$$FMTE^XLFDT($P(^SPNL(154,SPNDFN,0),"^",2),"5DZP")
|
---|
| 72 | S SPNETI=$O(^SPNL(154,SPNDFN,"E",SPNETI))
|
---|
| 73 | I SPNETI'<1 D ETI
|
---|
| 74 | W ?65,$E($$GET^DDSVAL(154,SPNDFN,2.6,"","E"),1,15)
|
---|
| 75 | ;S SPNZZ=1
|
---|
| 76 | ;I SPNETI'<1 F S SPNETI=$O(^SPNL(154,SPNDFN,"E",SPNETI)) Q:SPNETI<1 D Q:SPNLEXIT
|
---|
| 77 | ;.Q:SPNLEXIT
|
---|
| 78 | ;.D ETI S SPNZZ=0
|
---|
| 79 | ;.Q
|
---|
| 80 | S SPNCOU=SPNCOU+1
|
---|
| 81 | Q
|
---|
| 82 | ETI ;Print A patinet Etiology
|
---|
| 83 | N SPNETO
|
---|
| 84 | S SPNETO=$P($G(^SPNL(154,SPNDFN,"E",SPNETI,0)),U) Q:SPNETO=""
|
---|
| 85 | W ?45,$E($$GET^DDSVAL(154.03,SPNETO,.01,"","E"),1,18)
|
---|
| 86 | Q
|
---|
| 87 | HEAD ; Header Print
|
---|
| 88 | I SPNPAGE>1 Q:$Y<(IOSL-4)
|
---|
| 89 | I $E(IOST,1)="C" D Q:SPNLEXIT
|
---|
| 90 | .I SPNPAGE=1 W @IOF Q
|
---|
| 91 | .I SPNPAGE'=1 D Q:SPNLEXIT
|
---|
| 92 | ..N DIR S DIR(0)="E" D ^DIR I 'Y S SPNLEXIT=1
|
---|
| 93 | ..K Y
|
---|
| 94 | ..Q
|
---|
| 95 | .Q
|
---|
| 96 | Q:SPNLEXIT
|
---|
| 97 | I SPNPAGE'=1 W @IOF
|
---|
| 98 | W !,$$FMTE^XLFDT($$NOW^XLFDT,1),?70,"Page: ",SPNPAGE
|
---|
| 99 | W !,?18,"Listing of NEW SCD/SCI Patients Since ",$$FMTE^XLFDT(SPNDATE,1)
|
---|
| 100 | W !,"Patient",?20,"SSN",?33,"Original",?45,"Etiology",?65,"VA SCI Status"
|
---|
| 101 | W !,?33,"Regis Date"
|
---|
| 102 | W !,$$REPEAT^XLFSTR("-",79)
|
---|
| 103 | S SPNPAGE=SPNPAGE+1
|
---|
| 104 | I $D(ZTQUEUED) S:$$STPCK^SPNPRTMT SPNLEXIT=1
|
---|
| 105 | Q
|
---|