source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLR.m

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1SPNLR ;ISC-SF/GB-SCD REPORTS MAIN CONTROLLER ;1/10/2002
2 ;;2.0;Spinal Cord Dysfunction;**3,6,19**;01/02/1997
3 ; This routine provides overall control for the local SCD reports.
4 ; It expects to be called with the ID of the report to be produced.
5ENTRY(RPTID) ;
6 N ABORT,FDATE,TDATE,HIUSERS,QLIST
7 S ABORT=0
8 S SPNLEXIT=0 D EN1^SPNPRTMT Q:SPNLEXIT ;Filters
9 D ASK^SPNLR1(RPTID,.FDATE,.TDATE,.QLIST,.HIUSERS,.ABORT) Q:ABORT
10 D GETDEV Q:ABORT
11 I $D(IO("Q")) D CRE8TASK Q
12 D CRE8RPT
13 Q
14GETDEV ; Ask the user to which device to print the report
15 N POP
16 S %ZIS="QM"
17 D ^%ZIS
18 I POP S ABORT=1
19 Q
20CRE8TASK ;
21 N ZTRTN,ZTSAVE,ZTDESC,RDESC,TASKSTAT,DIR,Y
22 S RDESC("A")="Patient Listing"
23 S RDESC("B")="Breakdown of Patients Rpt"
24 S RDESC("C")="Current Inpatients Rpt"
25 S RDESC("D")="Follow Up Rpt (Last Seen)"
26 S RDESC("E")="Follow Up Rpt (Last Annual Rehab Eval)"
27 S RDESC("F")="Patient Health Summary"
28 S RDESC("J")="Inpatient/Outpatient Activity Rpt"
29 S RDESC("K")="Laboratory Utilization Rpt"
30 S RDESC("L")="Pharmacy Utilization Rpt"
31 S RDESC("M")="Radiology Utilization Rpt"
32 S RDESC("Q")="Specific Inpatient/Outpatient Activity Rpt"
33 S RDESC("R")="Specific Laboratory Utilization Rpt"
34 S RDESC("S")="Specific Pharmacy Utilization Rpt"
35 S ZTRTN="CRE8RPT^SPNLR"
36 S ZTSAVE("RPTID")=""
37 S ZTSAVE("FDATE")=""
38 S ZTSAVE("TDATE")=""
39 S ZTSAVE("HIUSERS")=""
40 S ZTSAVE("QLIST(")="" ; QLIST is an array
41 S ZTSAVE("SPNLTRAM")=""
42 S ZTSAVE("SPNLTRM1")=""
43 S ZTDESC=RDESC(RPTID)
44 S ZTSAVE("^TMP($J,"""_"SPNPRT"_""",")=""
45 D ^%ZTLOAD
46 S TASKSTAT=Y
47 D HOME^%ZIS
48 W:TASKSTAT'=-1 !!,$$CENTER^SPNLRU("**** Your task has been queued ****"),!
49 S DIR(0)="E" D ^DIR ; Hit return to continue
50 Q
51CRE8RPT ;
52 N ABORT,FACNAME,FACNR,SPNPAGE,PID,XFDATE,XTDATE,PCOUNT,DIR
53 U IO
54 I RPTID="F" D PRINT^SPNLRF(.QLIST) Q ; Patient Health Summary
55 S (ABORT,PCOUNT,SPNPAGE)=0
56 ; Get facility number from the site parameters file
57 S FACNR=+$P($G(^SPNL(154.91,1,0)),U,1)
58 ; Look up facility name in the institution file
59 I $D(^DIC(4,"D",FACNR)) S FACNAME=$P($G(^DIC(4,$O(^DIC(4,"D",FACNR,0)),0)),U,1)
60 E S FACNAME="Your Facility Name Here"
61 S XFDATE=$E(FDATE,4,5)_"/"_$E(FDATE,6,7)_"/"_((17+($E(FDATE)))_$E(FDATE,2,3))
62 S XTDATE=$E(TDATE,4,5)_"/"_$E(TDATE,6,7)_"/"_((17+($E(TDATE)))_$E(TDATE,2,3))
63 K ^TMP("SPN",$J)
64 W:IOST["C-" !,"Gathering patient data"
65 S PID=0
66 F S PID=$O(^SPNL(154,PID)) Q:(PID="")!('+PID) D ; entries are DINUM'd!
67 . I '$$EN2^SPNPRTMT(PID) Q ; Patient fail the filters
68 . I $D(SPNLTRAM) Q:$$TRAUMA^SPNLRU1(PID)'>0
69 . I IOST["C-" S PCOUNT=PCOUNT+1 W:(PCOUNT#50=0) "."
70 . D @("GATHER^SPNLR"_RPTID_"(PID,FDATE,TDATE,HIUSERS,.QLIST)")
71 D @("PRINT^SPNLR"_RPTID_"(FACNAME,XFDATE,XTDATE,HIUSERS,.QLIST,.ABORT)")
72 I IOST["C-",'ABORT S DIR(0)="E" D ^DIR ; Hit return to continue
73 K ^TMP("SPN",$J)
74 D ^%ZISC
75 K RPTID,FDATE,TDATE,HIUSERS,QLIST
76 Q
Note: See TracBrowser for help on using the repository browser.