1 | GMRCPSL4 ;SLC/MA - Special Consult Reports;1/10/02 14:27 ;1/17/02 18:20
|
---|
2 | ;;3.0;CONSULT/REQUEST TRACKING;**23,22**;DEC 27, 1997
|
---|
3 | ; This routine is called by GMRCPSL2 to generate reports or
|
---|
4 | ; date output.
|
---|
5 | ; DBIA 10035 call DIQ=2 ;PATIENT FILE
|
---|
6 | ; DBIA 10040 call DIQ=44 ;LOCATION FILE
|
---|
7 | ; DBIA 10060 call DIQ=200 ;NEW PERSON FILE
|
---|
8 | ; DISPLINE = ^GMR(123,,0) + FORMATED 12 NODE
|
---|
9 | DATAONLY ; Write data only for user to capture
|
---|
10 | N SRT1,SRT2,SRT3,IEN,DISPLINE
|
---|
11 | ; DATA LINE = IEN^REQ DATE^PROVIDER^LOCATION^TO SERVICE^
|
---|
12 | ; PATIENT^SSN^STATUS^PROCEDURE
|
---|
13 | S SRT1="",SRTCOMP=""
|
---|
14 | W !,"Consult#^Req Date^Ordering Provider^Location^"
|
---|
15 | W "To Service^Patient^SSN^Status^Procedure"
|
---|
16 | W !
|
---|
17 | F S SRT1=$O(^TMP("GMRCRPT",$J,SRT1)) Q:'$L(SRT1) D
|
---|
18 | . S SRT2=0
|
---|
19 | . F S SRT2=$O(^TMP("GMRCRPT",$J,SRT1,SRT2)) Q:'SRT2 D
|
---|
20 | . . S SRT3=0
|
---|
21 | . . F S SRT3=$O(^TMP("GMRCRPT",$J,SRT1,SRT2,SRT3)) Q:'SRT3 D
|
---|
22 | . . . S DISPLINE=^TMP("GMRCRPT",$J,SRT1,SRT2,SRT3)
|
---|
23 | . . . D DATAMOVE
|
---|
24 | Q
|
---|
25 | DATAMOVE ; Create the DATA ONLY OUTPUT
|
---|
26 | N DATALINE
|
---|
27 | S $P(DATALINE,"^",1)=$P(DISPLINE,"|",1) ;IEN
|
---|
28 | S $P(DATALINE,"^",2)=$$FMTE^XLFDT($P(DISPLINE,"^",7),"D") ;REQ Date
|
---|
29 | ; Provider not Null. If null the must be an IFC record
|
---|
30 | I +$P(DISPLINE,"^",14) D
|
---|
31 | . S $P(DATALINE,"^",3)=$$GET1^DIQ(200,$P(DISPLINE,"^",14),.01) ;PROVIDER
|
---|
32 | ; Provider Null, REMOTE ORDERING PROVIDER not. IFC record
|
---|
33 | I '+$P(DISPLINE,"^",14),$P(DISPLINE,"^",24)'="" D
|
---|
34 | . S $P(DATALINE,"^",3)=$P(DISPLINE,"^",24) ;PROVIDER
|
---|
35 | ;
|
---|
36 | ; Patient location not null. If null then must be an IFC record
|
---|
37 | I +$P(DISPLINE,"^",4) D
|
---|
38 | . S $P(DATALINE,"^",4)=$$GET1^DIQ(44,$P(DISPLINE,"^",4),.01)
|
---|
39 | ;
|
---|
40 | ; Patient Location null, Ordering Facility not. IFC record
|
---|
41 | I '+$P(DISPLINE,"^",4),+$P(DISPLINE,"^",21) D
|
---|
42 | . S $P(DATALINE,"^",4)=$$GET1^DIQ(4,$P(DISPLINE,"^",21),.01)
|
---|
43 | ;
|
---|
44 | ; Patient Location null, Ordering Facility null, Routing Facility not
|
---|
45 | ; IFC record
|
---|
46 | I '+$P(DISPLINE,"^",4),'+$P(DISPLINE,"^",21),+$P(DISPLINE,"^",23) D
|
---|
47 | . S $P(DATALINE,"^",4)=$$GET1^DIQ(4,$P(DISPLINE,"^",23),.01)
|
---|
48 | ;
|
---|
49 | S $P(DATALINE,"^",5)=$$GET1^DIQ(123.5,$P(DISPLINE,"^",5),.01) ;TO SERVICE
|
---|
50 | S $P(DATALINE,"^",6)=$$GET1^DIQ(2,$P(DISPLINE,"^",2),.01) ;PATIENT
|
---|
51 | S $P(DATALINE,"^",7)=$E($$GET1^DIQ(2,$P(DISPLINE,"^",2),.09),6,10) ;SSN
|
---|
52 | S $P(DATALINE,"^",8)=$$GET1^DIQ(100.01,$P(DISPLINE,"^",12),.1) ;STATUS
|
---|
53 | I $P(DISPLINE,"^",8)>"" D
|
---|
54 | . S $P(DATALINE,"^",9)=$$GET1^DIQ(123.3,$P($P(DISPLINE,"^",8),";",1),.01) ;PROCEDURE
|
---|
55 | W !,DATALINE
|
---|
56 | Q
|
---|