source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPRT05.m@ 1154

Last change on this file since 1154 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1SPNPRT05 ;HIRMFO/WAA- PRINT Possible New SCD/SCI Registrant ;8/29/96 15:41
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3 ;;
4EN1 ; Main Entry Point
5 N SPNLEXIT,SPNIO,SPNPAGE,SPNDATE,SPNEDAT,SPNCOU S SPNPAGE=1
6 D EN1^SPNCMR
7 S ZTSAVE("SPN*")="",ZTSAVE("^TMP($J,""SPNWC"",")=""
8 D DEVICE^SPNPRTMT("PRINT^SPNPRT05","Possible new SCD Patients",.ZTSAVE) Q:SPNLEXIT
9 I SPNIO="Q" D EXIT Q ; Print was Queued
10 I IO'="" D ENTSK D EXIT Q ; Print was not Queued
11 Q
12EXIT ; Exit routine
13 K ^TMP($J,"SPN"),^TMP($J,"SPNPRT","AUTO"),^TMP($J,"SPNPRT","POST")
14 K SPNDATE
15 Q
16ENTSK U IO
17 D EN1^SPNCMR2,EN1^SPNCMR3
18 S SPNPAGE=1,X="NOW" D ^%DT S SPNPDT=$$FMTE^XLFDT(Y,2)
19 D PRINT
20 Q
21PRINT ; Print main Body
22 U IO
23 S SPNLEXIT=$G(SPNLEXIT,0) ; Ensure that the exit is set
24 S SPNHLOC="" F S SPNHLOC=$O(^TMP($J,"SPNWC","C",SPNHLOC)) Q:SPNHLOC="" S SPNX=0 Q:SPNLEXIT F S SPNX=$O(^(SPNHLOC,SPNX)) Q:SPNX<1 D Q:SPNLEXIT
25 .S SPN=^TMP($J,"SPNWC",SPNX)
26 .S (SPNCOU,SPNNEW)=0
27 .D HEAD Q:SPNLEXIT
28 .W !!,?10,$S(SPN="W":"WARD",SPN="M":"MODULE",SPN="C":"CLINIC",1:"UNKNOWN"),": ",$P(^SC(SPNX,0),U)
29 .S SPNNEW=1
30 .S SPNDATE=0 F S SPNDATE=$O(^TMP($J,"SPNWC",SPNX,SPNDATE)) Q:SPNDATE="" S (SPNFLG,SPNDFN)=0 F S SPNDFN=$O(^TMP($J,"SPNWC",SPNX,SPNDATE,SPNDFN)) Q:SPNDFN<1 D Q:SPNLEXIT
31 .. N SPNX
32 .. S (SPNLPRT)=0
33 .. Q:SPNLEXIT
34 .. Q:$G(^DPT(SPNDFN,0))="" ; No Zero node
35 .. S DFN=SPNDFN D DEM^VADPT
36 .. I +$$GET^DDSVAL(2,SPNDFN,57.4,"","I")=0 Q ; The patient is not SCD
37 .. I $D(^SPNL(154,SPNDFN,0)) Q ; Patient is in SCD Database
38 .. D HEAD Q:SPNLEXIT
39 .. D PATIENT(SPNDFN) Q:SPNLEXIT
40 .. Q
41 . W !!,?15,SPNCOU," Total Patients for this location."
42 . Q
43 I $E(IOST,1)="C" N DIR S DIR(0)="E" D ^DIR K Y
44 D CLOSE^SPNPRTMT
45 K ^TMP($J,"SPN")
46 Q
47PATIENT(SPNDFN) ; Print Patient data
48 Q:SPNLEXIT
49 N SPNETI,SPNZZ
50 S DFN=SPNDFN,SPNETI=0,SPNCOU=SPNCOU+1
51 D DEM^VADPT
52 S DFN=SPNDFN
53 D INP^VADPT
54 W !,$E(VADM(1),1,24)," ",$P(VADM(2),U,2),?40,$$FMTE^XLFDT($P(VAIN(7),U),"2D"),?54,$E($$GET^DDSVAL(2,.SPNDFN,57.4,"","E"),1,25)
55 Q
56HEAD ; Header Print
57 I SPNNEW Q:$Y<(IOSL-4)
58 I $E(IOST,1)="C" D Q:SPNLEXIT
59 .I SPNPAGE=1 W @IOF Q
60 .I SPNPAGE'=1 D Q:SPNLEXIT
61 ..N DIR S DIR(0)="E" D ^DIR
62 ..I 'Y S SPNLEXIT=1
63 ..E W @IOF
64 ..K Y
65 ..Q
66 .Q
67 Q:SPNLEXIT
68 W !,$$FMTE^XLFDT($$NOW^XLFDT,1),?70,"Page: ",SPNPAGE
69 W !,?18,"Listing of NEW SCD/SCI Patients" W:$D(SPNDATE) " Since ",$$FMTE^XLFDT(SPNDATE,1)
70 I SPNSEL["1" S SPNTL="CURRENT INPATIENTS"
71 I SPNSEL["2" S SPNTL=$S(SPNTL="":"OUTPATIENTS",1:SPNTL_" / OUTPATIENTS")
72 I SPNSEL["3" S SPNTL=$S(SPNTL="":"NEW ADMISSIONS",1:SPNTL_" / NEW ADMISSIONS")
73 W !,?(40-($L(SPNTL)/2)),SPNTL
74 I (SPNSEL["2"!(SPNSEL["3")) W !,?22,"FROM ",$$FMTE^XLFDT(SPNST,2),?43,"TO ",$$FMTE^XLFDT(SPNED,2)
75 W !,"Patient",?35,"Date of ADMISSION",?54,"SCD flag"
76 W !,$$REPEAT^XLFSTR("-",79)
77 S SPNPAGE=SPNPAGE+1
78 I $D(ZTQUEUED) S:$$STPCK^SPNPRTMT SPNLEXIT=1
79 Q
Note: See TracBrowser for help on using the repository browser.