GMRCPSL4 ;SLC/MA - Special Consult Reports;15-Mar-2012 10:40;PLS
;;3.0;CONSULT/REQUEST TRACKING;**23,22,1001,1003**;DEC 27, 1997;Build 14
; This routine is called by GMRCPSL2 to generate reports or
; date output.
;Modified - IHS/CIA/MGH - 12/19/2005 - Line DATAONLY+6, DATAMOVE+26 - Code changed to use HRCN instead of SSN
; 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^"
;IHS/CIA/MGH Code change to use HRCN
;W "To Service^Patient^SSN^Status^Procedure"
W "To Service^Patient^HRCN^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
;IHS/CIA/MGH code change to use HRCN
;S $P(DATALINE,"^",7)=$E($$GET1^DIQ(2,$P(DISPLINE,"^",2),.09),6,10) ;SSN
S $P(DATALINE,"^",7)=$$HRCN^GMRCMP($P(DISPLINE,"^",2),+$G(DUZ(2))) ;HRCN
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
GMRCPSL4 ;SLC/MA - Special Consult Reports;15-Mar-2012 10:40;PLS
+1 ;;3.0;CONSULT/REQUEST TRACKING;**23,22,1001,1003**;DEC 27, 1997;Build 14
+2 ; This routine is called by GMRCPSL2 to generate reports or
+3 ; date output.
+4 ;Modified - IHS/CIA/MGH - 12/19/2005 - Line DATAONLY+6, DATAMOVE+26 - Code changed to use HRCN instead of SSN
+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
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 ;IHS/CIA/MGH Code change to use HRCN
+7 ;W "To Service^Patient^SSN^Status^Procedure"
+8 WRITE "To Service^Patient^HRCN^Status^Procedure"
+9 WRITE !
+10 FOR
SET SRT1=$ORDER(^TMP("GMRCRPT",$JOB,SRT1))
IF '$LENGTH(SRT1)
QUIT
Begin DoDot:1
+11 SET SRT2=0
+12 FOR
SET SRT2=$ORDER(^TMP("GMRCRPT",$JOB,SRT1,SRT2))
IF 'SRT2
QUIT
Begin DoDot:2
+13 SET SRT3=0
+14 FOR
SET SRT3=$ORDER(^TMP("GMRCRPT",$JOB,SRT1,SRT2,SRT3))
IF 'SRT3
QUIT
Begin DoDot:3
+15 SET DISPLINE=^TMP("GMRCRPT",$JOB,SRT1,SRT2,SRT3)
+16 DO DATAMOVE
End DoDot:3
End DoDot:2
End DoDot:1
+17 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 ;IHS/CIA/MGH code change to use HRCN
+27 ;S $P(DATALINE,"^",7)=$E($$GET1^DIQ(2,$P(DISPLINE,"^",2),.09),6,10) ;SSN
+28 ;HRCN
SET $PIECE(DATALINE,"^",7)=$$HRCN^GMRCMP($PIECE(DISPLINE,"^",2),+$GET(DUZ(2)))
+29 ;STATUS
SET $PIECE(DATALINE,"^",8)=$$GET1^DIQ(100.01,$PIECE(DISPLINE,"^",12),.1)
+30 IF $PIECE(DISPLINE,"^",8)>""
Begin DoDot:1
+31 ;PROCEDURE
SET $PIECE(DATALINE,"^",9)=$$GET1^DIQ(123.3,$PIECE($PIECE(DISPLINE,"^",8),";",1),.01)
End DoDot:1
+32 WRITE !,DATALINE
+33 QUIT
