source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLGE.m@ 1076

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1SPNLGE ; ISC-SF/GMB - SCD GATHER EXTRACTS FOR SHIPMENT ;6/29/95 09:18
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3INIT(ABORT) ; Call this once, before you start the extract process
4 S SPNDATE=DT ; variables used by ADDREC & FINISHUP subroutines
5 ; Get facility number from the site parameters file
6 S SPNFACNR=$P($G(^SPNL(154.91,1,0)),U,1)
7 Q:SPNFACNR>0
8 W !,"Facility number in site parameters file ^SPNL(154.91 is not initialized!"
9 S ABORT=1
10 Q
11EXTRACT(DFN,FDATE,TDATE,CLEARTXT,ABORT) ; Call this for each registry patient
12 ; DFN Patient's internal entry number in the Patient file
13 ; FDATE "From" date
14 ; TDATE "Thru" date, default=today
15 ; CLEARTXT 1=translate all codes to their meaning,
16 ; 0=don't translate codes (default=0)
17 ; ABORT Set and returned by this routine. Initially set to 0
18 ; Set to 1 if any errors are noticed.
19 ; (Actually, right now, ABORT will always be 0)
20 N SPNSSN,SPNRECNR ; variables used by ADDREC subroutine
21 N VADM,VA
22 I '$D(TDATE) S TDATE=DT
23 I '$D(CLEARTXT) S CLEARTXT=0
24 S ABORT=0
25 D DEM^VADPT
26 S SPNSSN=$$EN^SPNLGUCD(VA("PID"))
27 S SPNRECNR=0 D EXTRACT^SPNLGEAA(DFN,CLEARTXT,.ABORT) Q:ABORT
28 S SPNRECNR=0 D EXTRACT^SPNLGEFM(DFN,CLEARTXT,.ABORT) Q:ABORT
29 ;S SPNRECNR=0 D EXTRACT^SPNLGECH(DFN,FDATE,TDATE,CLEARTXT,.ABORT) Q:ABORT
30 ;S SPNRECNR=0 D EXTRACT^SPNLGEDM(DFN,FDATE,TDATE,CLEARTXT,.ABORT) Q:ABORT
31 ;S SPNRECNR=0 D EXTRACT^SPNLGEIP(DFN,FDATE,TDATE,CLEARTXT,.ABORT) Q:ABORT
32 ;S SPNRECNR=0 D EXTRACT^SPNLGEOP(DFN,FDATE,TDATE,CLEARTXT,.ABORT) Q:ABORT
33 ;S SPNRECNR=0 D EXTRACT^SPNLGERA(DFN,FDATE,TDATE,CLEARTXT,.ABORT) Q:ABORT
34 ;S SPNRECNR=0 D EXTRACT^SPNLGERX(DFN,FDATE,TDATE,CLEARTXT,.ABORT) Q:ABORT
35 ;S SPNRECNR=0 D EXTRACT^SPNLGEUD(DFN,FDATE,TDATE,CLEARTXT,.ABORT) Q:ABORT
36 S ^TMP("SPNX",$J,SPNDATE,SPNFACNR,SPNSSN)=TDATE
37 Q
38ADDREC(TYPE,RECORD) ; Add the record to the others gathered.
39 ; This routine is called by the above extractors.
40 S SPNRECNR=SPNRECNR+1
41 S ^TMP("SPNX",$J,SPNDATE,SPNFACNR,SPNSSN,TYPE,SPNRECNR)=RECORD
42 Q
43FINISHUP(FACINFO) ; Call this once, after the extract process is finished
44 S ^TMP("SPNX",$J,SPNDATE,SPNFACNR)=FACINFO
45 K SPNDATE,SPNFACNR
46 Q
Note: See TracBrowser for help on using the repository browser.