DGPFHLU1 ;ALB/RPM - PRF HL7 BUILD OBR SEGMENT ; 2/18/03
;;5.3;Registration;**425,1015**;Aug 13, 1993;Build 21
;
Q
;
OBR(DGSET,DGPFA,DGPFAH,DGFLD,DGHL) ;OBR Segment API
;This function wraps the data retrieval and segment creation APIs and
;returns a formatted OBR segment.
;
; Input:
; DGSET - (required) OBR segment Set ID
; DGPFA - (required) Assignment data array
; DGPFAH - (required) Assignment history data array
; DGFLD - (optional) List of comma-separated fields (sequence #'s)
; to include. Defaults to all required fields (4).
; DGHL - HL7 environment array
;
; Output:
; Function Value - OBR segment on success, "" on failure
;
N DGOBR
N DGVAL
;
S DGOBR=""
I $G(DGSET)>0,$D(DGPFA),$D(DGPFAH) D
. S DGFLD=$$CKSTR^DGPFHLUT("4",DGFLD) ;validate the field string
. S DGFLD=","_DGFLD_","
. I $$OBRVAL(DGFLD,DGSET,.DGPFA,.DGPFAH,.DGVAL) D
. . S DGOBR=$$BLDSEG^DGPFHLUT("OBR",.DGVAL,.DGHL)
Q DGOBR
;
OBRVAL(DGFLD,DGSET,DGPFA,DGPFAH,DGVAL) ;build OBR value array
;
; Input:
; DGFLD - (required) Fields string
; DGSET - (required) OBR segment Set ID
; DGPFA - (required) Assignment data array
; DGPFAH - (required) Assignment history data array
;
; Output:
; Function Value - 1 on sucess, 0 on failure
; DGVAL - OBR field array [SUB1:field, SUB2:repetition,
; SUB3:component, SUB4:sub-component]
;
N DGRSLT ;function value
N DGADT ;assignment date
N DGORIG ;originating site
N DGOWN ;assignment owner
;
S DGRSLT=0
I $G(DGFLD)]"",+$G(DGSET)>0,+$G(DGPFA("FLAG"))>0,+$G(DGPFAH("ASSIGN"))>0 D
. ;
. ; seq 1 Set ID
. I DGFLD[",1," D
. . S DGVAL(1)=DGSET
. ;
. ; seq 2 Placer Order Number
. I DGFLD[",2," D
. ;
. ; seq 3 Filler Order Number
. I DGFLD[",3," D
. ;
. ; seq 4 Universal Service ID
. I DGFLD[",4," D ;required field
. . S DGVAL(4,1,1)=+DGPFA("FLAG") ;flag record# only, not IEN
. . S DGVAL(4,1,2)=$P(DGPFA("FLAG"),U,2) ;flag name
. . S DGVAL(4,1,3)="VA085" ;table name
. ;
. ; seq 5 Priority
. I DGFLD[",5," D
. ;
. ; seq 6 Requested Date/time
. I DGFLD[",6," D
. ;
. ; seq 7 Observation Date/Time
. I DGFLD[",7," D
. . S DGADT=$$FMTHL7^XLFDT(+$$GETADT^DGPFAAH(+DGPFAH("ASSIGN")))
. . S DGVAL(7)=$S(DGADT>0:DGADT,1:"")
. ;
. ; seq 8 Observation End Date/Time
. I DGFLD[",8," D
. ;
. ; seq 9 Collection volume
. I DGFLD[",9," D
. ;
. ; seq 10 Collector Identifier
. I DGFLD[",10," D
. ;
. ; seq 11 Specimen Action Code
. I DGFLD[",11," D
. ;
. ; seq 12 Danger Code
. I DGFLD[",12," D
. ;
. ; seq 13 Relevant Clinical Info
. I DGFLD[",13," D
. ;
. ; seq 14 Specimen Received Date/Time
. I DGFLD[",14," D
. ;
. ; seq 15 Specimen Source
. I DGFLD[",15," D
. ;
. ; seq 16 Ordering Provider
. I DGFLD[",16," D
. ;
. ; seq 17 Order Callback Phone Number
. I DGFLD[",17," D
. ;
. ; seq 18 Placer field 1
. I DGFLD[",18," D
. ;
. ; seq 19 Placer field 2
. I DGFLD[",19," D
. ;
. ; seq 20 Filler field 1
. I DGFLD[",20," D
. . S DGOWN=+$G(DGPFA("OWNER"))
. . S DGVAL(20)=$S(DGOWN>0:$$STA^XUAF4(DGOWN),1:"")
. ;
. ; seq 21 Filler Field 2
. I DGFLD[",21," D
. . S DGORIG=+$G(DGPFA("ORIGSITE"))
. . S DGVAL(21)=$S(DGORIG>0:$$STA^XUAF4(DGORIG),1:"")
. ;
. ; seq 22 Results Rpt/Status Chng - Date/Time
. I DGFLD[",22," D
. ;
. ; seq 23 Charge to Practice
. I DGFLD[",23," D
. ;
. ; seq 24 Diagnostic Serv Sect ID
. I DGFLD[",24," D
. ;
. ; seq 25 Result Status
. I DGFLD[",25," D
. ;
. ; seq 26 Parent Result
. I DGFLD[",26," D
. ;
. ; seq 27 Quantity/Timing
. I DGFLD[",27," D
. ;
. ; seq 28 Result Copies To
. I DGFLD[",28," D
. ;
. ; seq 29 Parent
. I DGFLD[",29," D
. ;
. ; seq 30 Transportation Mode
. I DGFLD[",30," D
. ;
. ; seq 31 Reason for Study
. I DGFLD[",31," D
. ;
. ; seq 32 Principal Result Interpreter
. I DGFLD[",32," D
. ;
. ; seq 33 Assistant Result Interpreter
. I DGFLD[",33," D
. ;
. ; seq 34 Technician
. I DGFLD[",34," D
. ;
. ; seq 35 Transcription
. I DGFLD[",35," D
. ;
. ; seq 36 Scheduled Date/Time
. I DGFLD[",36," D
. ;
. ; seq 37 Number of Sample Containers
. I DGFLD[",37," D
. ;
. ; seq 38 Transport Logistics of Collected Sample
. I DGFLD[",38," D
. ;
. ; seq 39 Collector's Comment
. I DGFLD[",39," D
. ;
. ; seq 40 Transport Arrangement Responsibility
. I DGFLD[",40," D
. ;
. ; seq 41 Transport Arranged
. I DGFLD[",41," D
. ;
. ; seq 42 Escort Required
. I DGFLD[",42," D
. ;
. ; seq 43 Planned Patient Transport Comment
. I DGFLD[",43," D
. ;
. S DGRSLT=1
I 'DGRSLT K DGVAL
Q DGRSLT
DGPFHLU1 ;ALB/RPM - PRF HL7 BUILD OBR SEGMENT ; 2/18/03
+1 ;;5.3;Registration;**425,1015**;Aug 13, 1993;Build 21
+2 ;
+3 QUIT
+4 ;
OBR(DGSET,DGPFA,DGPFAH,DGFLD,DGHL) ;OBR Segment API
+1 ;This function wraps the data retrieval and segment creation APIs and
+2 ;returns a formatted OBR segment.
+3 ;
+4 ; Input:
+5 ; DGSET - (required) OBR segment Set ID
+6 ; DGPFA - (required) Assignment data array
+7 ; DGPFAH - (required) Assignment history data array
+8 ; DGFLD - (optional) List of comma-separated fields (sequence #'s)
+9 ; to include. Defaults to all required fields (4).
+10 ; DGHL - HL7 environment array
+11 ;
+12 ; Output:
+13 ; Function Value - OBR segment on success, "" on failure
+14 ;
+15 NEW DGOBR
+16 NEW DGVAL
+17 ;
+18 SET DGOBR=""
+19 IF $GET(DGSET)>0
IF $DATA(DGPFA)
IF $DATA(DGPFAH)
Begin DoDot:1
+20 ;validate the field string
SET DGFLD=$$CKSTR^DGPFHLUT("4",DGFLD)
+21 SET DGFLD=","_DGFLD_","
+22 IF $$OBRVAL(DGFLD,DGSET,.DGPFA,.DGPFAH,.DGVAL)
Begin DoDot:2
+23 SET DGOBR=$$BLDSEG^DGPFHLUT("OBR",.DGVAL,.DGHL)
End DoDot:2
End DoDot:1
+24 QUIT DGOBR
+25 ;
OBRVAL(DGFLD,DGSET,DGPFA,DGPFAH,DGVAL) ;build OBR value array
+1 ;
+2 ; Input:
+3 ; DGFLD - (required) Fields string
+4 ; DGSET - (required) OBR segment Set ID
+5 ; DGPFA - (required) Assignment data array
+6 ; DGPFAH - (required) Assignment history data array
+7 ;
+8 ; Output:
+9 ; Function Value - 1 on sucess, 0 on failure
+10 ; DGVAL - OBR field array [SUB1:field, SUB2:repetition,
+11 ; SUB3:component, SUB4:sub-component]
+12 ;
+13 ;function value
NEW DGRSLT
+14 ;assignment date
NEW DGADT
+15 ;originating site
NEW DGORIG
+16 ;assignment owner
NEW DGOWN
+17 ;
+18 SET DGRSLT=0
+19 IF $GET(DGFLD)]""
IF +$GET(DGSET)>0
IF +$GET(DGPFA("FLAG"))>0
IF +$GET(DGPFAH("ASSIGN"))>0
Begin DoDot:1
+20 ;
+21 ; seq 1 Set ID
+22 IF DGFLD[",1,"
Begin DoDot:2
+23 SET DGVAL(1)=DGSET
End DoDot:2
+24 ;
+25 ; seq 2 Placer Order Number
+26 IF DGFLD[",2,"
Begin DoDot:2
End DoDot:2
+27 ;
+28 ; seq 3 Filler Order Number
+29 IF DGFLD[",3,"
Begin DoDot:2
End DoDot:2
+30 ;
+31 ; seq 4 Universal Service ID
+32 ;required field
IF DGFLD[",4,"
Begin DoDot:2
+33 ;flag record# only, not IEN
SET DGVAL(4,1,1)=+DGPFA("FLAG")
+34 ;flag name
SET DGVAL(4,1,2)=$PIECE(DGPFA("FLAG"),U,2)
+35 ;table name
SET DGVAL(4,1,3)="VA085"
End DoDot:2
+36 ;
+37 ; seq 5 Priority
+38 IF DGFLD[",5,"
Begin DoDot:2
End DoDot:2
+39 ;
+40 ; seq 6 Requested Date/time
+41 IF DGFLD[",6,"
Begin DoDot:2
End DoDot:2
+42 ;
+43 ; seq 7 Observation Date/Time
+44 IF DGFLD[",7,"
Begin DoDot:2
+45 SET DGADT=$$FMTHL7^XLFDT(+$$GETADT^DGPFAAH(+DGPFAH("ASSIGN")))
+46 SET DGVAL(7)=$SELECT(DGADT>0:DGADT,1:"")
End DoDot:2
+47 ;
+48 ; seq 8 Observation End Date/Time
+49 IF DGFLD[",8,"
Begin DoDot:2
End DoDot:2
+50 ;
+51 ; seq 9 Collection volume
+52 IF DGFLD[",9,"
Begin DoDot:2
End DoDot:2
+53 ;
+54 ; seq 10 Collector Identifier
+55 IF DGFLD[",10,"
Begin DoDot:2
End DoDot:2
+56 ;
+57 ; seq 11 Specimen Action Code
+58 IF DGFLD[",11,"
Begin DoDot:2
End DoDot:2
+59 ;
+60 ; seq 12 Danger Code
+61 IF DGFLD[",12,"
Begin DoDot:2
End DoDot:2
+62 ;
+63 ; seq 13 Relevant Clinical Info
+64 IF DGFLD[",13,"
Begin DoDot:2
End DoDot:2
+65 ;
+66 ; seq 14 Specimen Received Date/Time
+67 IF DGFLD[",14,"
Begin DoDot:2
End DoDot:2
+68 ;
+69 ; seq 15 Specimen Source
+70 IF DGFLD[",15,"
Begin DoDot:2
End DoDot:2
+71 ;
+72 ; seq 16 Ordering Provider
+73 IF DGFLD[",16,"
Begin DoDot:2
End DoDot:2
+74 ;
+75 ; seq 17 Order Callback Phone Number
+76 IF DGFLD[",17,"
Begin DoDot:2
End DoDot:2
+77 ;
+78 ; seq 18 Placer field 1
+79 IF DGFLD[",18,"
Begin DoDot:2
End DoDot:2
+80 ;
+81 ; seq 19 Placer field 2
+82 IF DGFLD[",19,"
Begin DoDot:2
End DoDot:2
+83 ;
+84 ; seq 20 Filler field 1
+85 IF DGFLD[",20,"
Begin DoDot:2
+86 SET DGOWN=+$GET(DGPFA("OWNER"))
+87 SET DGVAL(20)=$SELECT(DGOWN>0:$$STA^XUAF4(DGOWN),1:"")
End DoDot:2
+88 ;
+89 ; seq 21 Filler Field 2
+90 IF DGFLD[",21,"
Begin DoDot:2
+91 SET DGORIG=+$GET(DGPFA("ORIGSITE"))
+92 SET DGVAL(21)=$SELECT(DGORIG>0:$$STA^XUAF4(DGORIG),1:"")
End DoDot:2
+93 ;
+94 ; seq 22 Results Rpt/Status Chng - Date/Time
+95 IF DGFLD[",22,"
Begin DoDot:2
End DoDot:2
+96 ;
+97 ; seq 23 Charge to Practice
+98 IF DGFLD[",23,"
Begin DoDot:2
End DoDot:2
+99 ;
+100 ; seq 24 Diagnostic Serv Sect ID
+101 IF DGFLD[",24,"
Begin DoDot:2
End DoDot:2
+102 ;
+103 ; seq 25 Result Status
+104 IF DGFLD[",25,"
Begin DoDot:2
End DoDot:2
+105 ;
+106 ; seq 26 Parent Result
+107 IF DGFLD[",26,"
Begin DoDot:2
End DoDot:2
+108 ;
+109 ; seq 27 Quantity/Timing
+110 IF DGFLD[",27,"
Begin DoDot:2
End DoDot:2
+111 ;
+112 ; seq 28 Result Copies To
+113 IF DGFLD[",28,"
Begin DoDot:2
End DoDot:2
+114 ;
+115 ; seq 29 Parent
+116 IF DGFLD[",29,"
Begin DoDot:2
End DoDot:2
+117 ;
+118 ; seq 30 Transportation Mode
+119 IF DGFLD[",30,"
Begin DoDot:2
End DoDot:2
+120 ;
+121 ; seq 31 Reason for Study
+122 IF DGFLD[",31,"
Begin DoDot:2
End DoDot:2
+123 ;
+124 ; seq 32 Principal Result Interpreter
+125 IF DGFLD[",32,"
Begin DoDot:2
End DoDot:2
+126 ;
+127 ; seq 33 Assistant Result Interpreter
+128 IF DGFLD[",33,"
Begin DoDot:2
End DoDot:2
+129 ;
+130 ; seq 34 Technician
+131 IF DGFLD[",34,"
Begin DoDot:2
End DoDot:2
+132 ;
+133 ; seq 35 Transcription
+134 IF DGFLD[",35,"
Begin DoDot:2
End DoDot:2
+135 ;
+136 ; seq 36 Scheduled Date/Time
+137 IF DGFLD[",36,"
Begin DoDot:2
End DoDot:2
+138 ;
+139 ; seq 37 Number of Sample Containers
+140 IF DGFLD[",37,"
Begin DoDot:2
End DoDot:2
+141 ;
+142 ; seq 38 Transport Logistics of Collected Sample
+143 IF DGFLD[",38,"
Begin DoDot:2
End DoDot:2
+144 ;
+145 ; seq 39 Collector's Comment
+146 IF DGFLD[",39,"
Begin DoDot:2
End DoDot:2
+147 ;
+148 ; seq 40 Transport Arrangement Responsibility
+149 IF DGFLD[",40,"
Begin DoDot:2
End DoDot:2
+150 ;
+151 ; seq 41 Transport Arranged
+152 IF DGFLD[",41,"
Begin DoDot:2
End DoDot:2
+153 ;
+154 ; seq 42 Escort Required
+155 IF DGFLD[",42,"
Begin DoDot:2
End DoDot:2
+156 ;
+157 ; seq 43 Planned Patient Transport Comment
+158 IF DGFLD[",43,"
Begin DoDot:2
End DoDot:2
+159 ;
+160 SET DGRSLT=1
End DoDot:1
+161 IF 'DGRSLT
KILL DGVAL
+162 QUIT DGRSLT
