source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCPSL4.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1GMRCPSL4 ;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
9DATAONLY ; 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
25DATAMOVE ; 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
Note: See TracBrowser for help on using the repository browser.