GMRCPSL4 ;SLC/MA - Special Consult Reports;1/10/02 14:27 ;1/17/02 18:20
;;3.0;CONSULT/REQUEST TRACKING;**23,22**;DEC 27, 1997
; This routine is called by GMRCPSL2 to generate reports or
; date output.
; DBIA 10035 call DIQ=2 ;PATIENT FILE
; DBIA 10040 call DIQ=44 ;LOCATION FILE
; DBIA 10060 call DIQ=200 ;NEW PERSON FILE
; DISPLINE = ^GMR(123,,0) + FORMATED 12 NODE
DATAONLY ; Write data only for user to capture
N SRT1,SRT2,SRT3,IEN,DISPLINE
; DATA LINE = IEN^REQ DATE^PROVIDER^LOCATION^TO SERVICE^
; PATIENT^SSN^STATUS^PROCEDURE
S SRT1="",SRTCOMP=""
W !,"Consult#^Req Date^Ordering Provider^Location^"
W "To Service^Patient^SSN^Status^Procedure"
W !
F S SRT1=$O(^TMP("GMRCRPT",$J,SRT1)) Q:'$L(SRT1) D
. S SRT2=0
. F S SRT2=$O(^TMP("GMRCRPT",$J,SRT1,SRT2)) Q:'SRT2 D
. . S SRT3=0
. . F S SRT3=$O(^TMP("GMRCRPT",$J,SRT1,SRT2,SRT3)) Q:'SRT3 D
. . . S DISPLINE=^TMP("GMRCRPT",$J,SRT1,SRT2,SRT3)
. . . D DATAMOVE
Q
DATAMOVE ; Create the DATA ONLY OUTPUT
N DATALINE
S $P(DATALINE,"^",1)=$P(DISPLINE,"|",1) ;IEN
S $P(DATALINE,"^",2)=$$FMTE^XLFDT($P(DISPLINE,"^",7),"D") ;REQ Date
; Provider not Null. If null the must be an IFC record
I +$P(DISPLINE,"^",14) D
. S $P(DATALINE,"^",3)=$$GET1^DIQ(200,$P(DISPLINE,"^",14),.01) ;PROVIDER
; Provider Null, REMOTE ORDERING PROVIDER not. IFC record
I '+$P(DISPLINE,"^",14),$P(DISPLINE,"^",24)'="" D
. S $P(DATALINE,"^",3)=$P(DISPLINE,"^",24) ;PROVIDER
;
; Patient location not null. If null then must be an IFC record
I +$P(DISPLINE,"^",4) D
. S $P(DATALINE,"^",4)=$$GET1^DIQ(44,$P(DISPLINE,"^",4),.01)
;
; Patient Location null, Ordering Facility not. IFC record
I '+$P(DISPLINE,"^",4),+$P(DISPLINE,"^",21) D
. S $P(DATALINE,"^",4)=$$GET1^DIQ(4,$P(DISPLINE,"^",21),.01)
;
; Patient Location null, Ordering Facility null, Routing Facility not
; IFC record
I '+$P(DISPLINE,"^",4),'+$P(DISPLINE,"^",21),+$P(DISPLINE,"^",23) D
. S $P(DATALINE,"^",4)=$$GET1^DIQ(4,$P(DISPLINE,"^",23),.01)
;
S $P(DATALINE,"^",5)=$$GET1^DIQ(123.5,$P(DISPLINE,"^",5),.01) ;TO SERVICE
S $P(DATALINE,"^",6)=$$GET1^DIQ(2,$P(DISPLINE,"^",2),.01) ;PATIENT
S $P(DATALINE,"^",7)=$E($$GET1^DIQ(2,$P(DISPLINE,"^",2),.09),6,10) ;SSN
S $P(DATALINE,"^",8)=$$GET1^DIQ(100.01,$P(DISPLINE,"^",12),.1) ;STATUS
I $P(DISPLINE,"^",8)>"" D
. S $P(DATALINE,"^",9)=$$GET1^DIQ(123.3,$P($P(DISPLINE,"^",8),";",1),.01) ;PROCEDURE
W !,DATALINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCPSL4 2543 printed Sep 23, 2025@19:22:59 Page 2
GMRCPSL4 ;SLC/MA - Special Consult Reports;1/10/02 14:27 ;1/17/02 18:20
+1 ;;3.0;CONSULT/REQUEST TRACKING;**23,22**;DEC 27, 1997
+2 ; This routine is called by GMRCPSL2 to generate reports or
+3 ; date output.
+4 ; DBIA 10035 call DIQ=2 ;PATIENT FILE
+5 ; DBIA 10040 call DIQ=44 ;LOCATION FILE
+6 ; DBIA 10060 call DIQ=200 ;NEW PERSON FILE
+7 ; DISPLINE = ^GMR(123,,0) + FORMATED 12 NODE
DATAONLY ; Write data only for user to capture
+1 NEW SRT1,SRT2,SRT3,IEN,DISPLINE
+2 ; DATA LINE = IEN^REQ DATE^PROVIDER^LOCATION^TO SERVICE^
+3 ; PATIENT^SSN^STATUS^PROCEDURE
+4 SET SRT1=""
SET SRTCOMP=""
+5 WRITE !,"Consult#^Req Date^Ordering Provider^Location^"
+6 WRITE "To Service^Patient^SSN^Status^Procedure"
+7 WRITE !
+8 FOR
SET SRT1=$ORDER(^TMP("GMRCRPT",$JOB,SRT1))
if '$LENGTH(SRT1)
QUIT
Begin DoDot:1
+9 SET SRT2=0
+10 FOR
SET SRT2=$ORDER(^TMP("GMRCRPT",$JOB,SRT1,SRT2))
if 'SRT2
QUIT
Begin DoDot:2
+11 SET SRT3=0
+12 FOR
SET SRT3=$ORDER(^TMP("GMRCRPT",$JOB,SRT1,SRT2,SRT3))
if 'SRT3
QUIT
Begin DoDot:3
+13 SET DISPLINE=^TMP("GMRCRPT",$JOB,SRT1,SRT2,SRT3)
+14 DO DATAMOVE
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
DATAMOVE ; Create the DATA ONLY OUTPUT
+1 NEW DATALINE
+2 ;IEN
SET $PIECE(DATALINE,"^",1)=$PIECE(DISPLINE,"|",1)
+3 ;REQ Date
SET $PIECE(DATALINE,"^",2)=$$FMTE^XLFDT($PIECE(DISPLINE,"^",7),"D")
+4 ; Provider not Null. If null the must be an IFC record
+5 IF +$PIECE(DISPLINE,"^",14)
Begin DoDot:1
+6 ;PROVIDER
SET $PIECE(DATALINE,"^",3)=$$GET1^DIQ(200,$PIECE(DISPLINE,"^",14),.01)
End DoDot:1
+7 ; Provider Null, REMOTE ORDERING PROVIDER not. IFC record
+8 IF '+$PIECE(DISPLINE,"^",14)
IF $PIECE(DISPLINE,"^",24)'=""
Begin DoDot:1
+9 ;PROVIDER
SET $PIECE(DATALINE,"^",3)=$PIECE(DISPLINE,"^",24)
End DoDot:1
+10 ;
+11 ; Patient location not null. If null then must be an IFC record
+12 IF +$PIECE(DISPLINE,"^",4)
Begin DoDot:1
+13 SET $PIECE(DATALINE,"^",4)=$$GET1^DIQ(44,$PIECE(DISPLINE,"^",4),.01)
End DoDot:1
+14 ;
+15 ; Patient Location null, Ordering Facility not. IFC record
+16 IF '+$PIECE(DISPLINE,"^",4)
IF +$PIECE(DISPLINE,"^",21)
Begin DoDot:1
+17 SET $PIECE(DATALINE,"^",4)=$$GET1^DIQ(4,$PIECE(DISPLINE,"^",21),.01)
End DoDot:1
+18 ;
+19 ; Patient Location null, Ordering Facility null, Routing Facility not
+20 ; IFC record
+21 IF '+$PIECE(DISPLINE,"^",4)
IF '+$PIECE(DISPLINE,"^",21)
IF +$PIECE(DISPLINE,"^",23)
Begin DoDot:1
+22 SET $PIECE(DATALINE,"^",4)=$$GET1^DIQ(4,$PIECE(DISPLINE,"^",23),.01)
End DoDot:1
+23 ;
+24 ;TO SERVICE
SET $PIECE(DATALINE,"^",5)=$$GET1^DIQ(123.5,$PIECE(DISPLINE,"^",5),.01)
+25 ;PATIENT
SET $PIECE(DATALINE,"^",6)=$$GET1^DIQ(2,$PIECE(DISPLINE,"^",2),.01)
+26 ;SSN
SET $PIECE(DATALINE,"^",7)=$EXTRACT($$GET1^DIQ(2,$PIECE(DISPLINE,"^",2),.09),6,10)
+27 ;STATUS
SET $PIECE(DATALINE,"^",8)=$$GET1^DIQ(100.01,$PIECE(DISPLINE,"^",12),.1)
+28 IF $PIECE(DISPLINE,"^",8)>""
Begin DoDot:1
+29 ;PROCEDURE
SET $PIECE(DATALINE,"^",9)=$$GET1^DIQ(123.3,$PIECE($PIECE(DISPLINE,"^",8),";",1),.01)
End DoDot:1
+30 WRITE !,DATALINE
+31 QUIT
