DGPFHLU1.m

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