- 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
