source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNLGEOP.m@ 686

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1SPNLGEOP ; ISC-SF/GMB - SCD GATHER OUTPATIENT DATA;11 MAY 94 [ 08/08/94 1:09 PM ] ;6/23/95 12:09
2 ;;2.0;Spinal Cord Dysfunction;**7**;01/02/1997
3EXTRACT(DFN,FDATE,TDATE,CLEARTXT,ABORT) ;
4 ; DFN Patient's internal entry number in the Patient file
5 ; FDATE "From" date
6 ; TDATE "Thru" date, default=today
7 ; CLEARTXT 1=translate all codes to their meaning,
8 ; 0=don't translate codes (default=0)
9 N APPT,APPTINFO,APPTDATE,YYY,MM,SCNUM,COUNT,WHEN,RECNR,SCPTR,VASD
10 I '$D(TDATE) S TDATE=DT
11 I '$D(CLEARTXT) S CLEARTXT=0
12 ; We change the days in the dates, because we track only whole months.
13 S FDATE=$E(FDATE,1,5)_"01"
14 S TDATE=$E(TDATE,1,5)_"31"
15 ; The following call returns all scheduled appointments which were
16 ; kept, and all future appointments, within the from/to dates
17 S VASD("F")=FDATE,VASD("T")=TDATE D SDA^VADPT
18 S APPT=0 ; date/time of appt.
19 F S APPT=$O(^UTILITY("VASD",$J,APPT)) Q:APPT="" D
20 . S APPTINFO=^UTILITY("VASD",$J,APPT,"I")
21 . S APPTDATE=$P(APPTINFO,U,1)\1
22 . S YYY=$E(APPTDATE,1,3)
23 . S MM=$E(APPTDATE,4,5)
24 . ; follow clinic ptr to hospital location to stop code number
25 . S SCNUM=$$STOPCODE^SPNLGU($P(APPTINFO,U,2))
26 . S $P(COUNT(SCNUM,YYY),U,MM)=$P($G(COUNT(SCNUM,YYY)),U,MM)+1
27 ; Now we count all "walk-ins" without appointments (unscheduled)
28 D UNSCH(DFN,FDATE,TDATE,"D CB^SPNLGEOP(Y,Y0,.SDSTOP)")
29 ; Now create transactions...
30 S SCNUM=""
31 F S SCNUM=$O(COUNT(SCNUM)) Q:SCNUM="" D
32 . S YYY=""
33 . F S YYY=$O(COUNT(SCNUM,YYY)) Q:YYY="" D
34 . . D ADDREC^SPNLGE("OP",SCNUM_"^"_YYY_"0000"_"^"_COUNT(SCNUM,YYY))
35 Q
36 ;
37UNSCH(SPNDFN,SPNST,SPNED,SPNCB) ; -- find Unscheduled encounter for patient for a date range
38 ; input: SPNDFN := ien of patient
39 ; SPNST := start date
40 ; SPNED := end date
41 ; SPNCB := callback code executed for each encounter in
42 ; query's result set
43 ;
44 ; -- set up scan
45 N SPNQRY
46 D OPEN^SDQ(.SPNQRY) ; -- initialize query
47 D INDEX^SDQ(.SPNQRY,"PATIENT/DATE","SET") ; -- which index to use
48 D PAT^SDQ(.SPNQRY,SPNDFN,"SET") ; -- patient
49 D DATE^SDQ(.SPNQRY,SPNST,SPNED,"SET") ; -- date range
50 D SCANCB^SDQ(.SPNQRY,SPNCB,"SET") ; -- callback code to use
51 D ACTIVE^SDQ(.SPNQRY,"TRUE","SET") ; -- activate query
52 ;
53 D SCAN^SDQ(.SPNQRY,"FORWARD") ; -- scan entries in query
54 ; result set
55 ;
56 D CLOSE^SDQ(.SPNQRY) ; -- close query
57 Q
58 ;
59CB(SPNOE,SPNOE0,SPNSTOP) ; -- callback code called for each
60 ; record in query result set
61 ;
62 ; input: SPNOE := ien of Outpatient Encounter
63 ; SPNOE0 := zeroth node of Outpatient Encounter
64 ; SPNSTOP := tells query to stop processing by setting to 1
65 ;
66 N SPNDATE,YYY,MM,SCPTR,SCNUM
67 IF $P(SPNOE0,U,6) G CBQ ; -- quit if encounter has parent
68 IF $P(SPNOE0,U,8)'=2 G CBQ ; -- quit if not standalone encounter
69 ;
70 S SPNDATE=+SPNOE0 ; -- encounter date
71 S YYY=$E(SPNDATE,1,3)
72 S MM=$E(SPNDATE,4,5)
73 S SCPTR=+$P(SPNOE0,U,3) ; -- stop code pointer
74 IF 'SCPTR G CBQ
75 S SCNUM=$P($G(^DIC(40.7,SCPTR,0)),U,2)
76 S $P(COUNT(SCNUM,YYY),U,MM)=$P($G(COUNT(SCNUM,YYY)),U,MM)+1
77CBQ Q
78 ;
Note: See TracBrowser for help on using the repository browser.