| 1 | SPNLGE ; ISC-SF/GMB - SCD GATHER EXTRACTS FOR SHIPMENT ;6/29/95 09:18
|
|---|
| 2 | ;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
|---|
| 3 | INIT(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
|
|---|
| 11 | EXTRACT(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
|
|---|
| 38 | ADDREC(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
|
|---|
| 43 | FINISHUP(FACINFO) ; Call this once, after the extract process is finished
|
|---|
| 44 | S ^TMP("SPNX",$J,SPNDATE,SPNFACNR)=FACINFO
|
|---|
| 45 | K SPNDATE,SPNFACNR
|
|---|
| 46 | Q
|
|---|
