VAFHLZGD.m

VAFHLZGD ;ALB/KCL/CPM - Create generic HL7 ZGD segment ; 17 Febuary 1993

 ;;5.3;Registration;**33,68**;Aug 13, 1993

 ;

 ;

EN(DFN,VAFSTR,VAFREQ,VAFNUM) ; This generic extrinsic function was

 ;                                 designed to return the HL7 ZGD

 ;                                 segment.  This segment contains

 ;                                 generic information pertaining to

 ;                                 a patient's legal guardian.

 ;

 ;  Input - DFN as internal entry number of the PATIENT file.

 ;          VAFSTR as string of fields requested separated by commas

 ;          VAFREQ is 1 if VA guardian data is requested, 2 if Civil

 ;                   guardian data is requested.

 ;          VAFNUM as sequential number to add to SET ID.

 ;

 ;     *****Also assumes all HL7 variables returned from*****

 ;          INIT^HLTRANS are defined.

 ;

 ; Output - String of data forming the HL7 ZGD segment.

 ;

 N VAFNODE,VAFY,X,X1

 I '$G(DFN)!($G(VAFSTR)']"") G QUIT

 I $G(VAFREQ)'=2 S VAFREQ=1 ; Default to VA guardian

 S $P(VAFY,HLFS,8)="",VAFSTR=","_VAFSTR_","

 S X=$P($T(GUAR+VAFREQ),";;",2),VAFNODE=$G(^DPT(DFN,X))

 S $P(VAFY,HLFS,1)=$G(VAFNUM)+1 ; Sequential number (Required field)

 S $P(VAFY,HLFS,2)=VAFREQ ; Guardian type (Required field)

 I VAFSTR[",3," S $P(VAFY,HLFS,3)=$S($P(VAFNODE,"^",4)]"":$P(VAFNODE,"^",4),1:HLQ) ; Guardian

 I VAFSTR[",4," S X=$P(VAFNODE,"^",3),X1=$S(VAFREQ=1:$P($G(^DIC(4,+X,0)),"^",1),1:X),$P(VAFY,HLFS,4)=$S(X1]"":X1,1:HLQ) ; Guardian Institution

 I VAFSTR[",5," S $P(VAFY,HLFS,5)=$S($P(VAFNODE,"^",5)]"":$P(VAFNODE,"^",5),1:HLQ) ; Relationship

 I VAFSTR[",6," S X1=$$ADDR^VAFHLFNC($P(VAFNODE,"^",6,7)_"^^"_$P(VAFNODE,"^",8,9)_"^"_$P(VAFNODE,"^",$P($T(GUAR+VAFREQ),";;",3))),$P(VAFY,HLFS,6)=$S(X1]"":X1,1:HLQ) ; Address

 I VAFSTR[",7," S X1=$$HLPHONE^HLFNC($P(VAFNODE,"^",11)),$P(VAFY,HLFS,7)=$S(X1]"":X1,1:HLQ) ; Phone

 I VAFSTR[",8," S X1=$$HLDATE^HLFNC($P($G(^DPT(DFN,.29)),"^",VAFREQ)),$P(VAFY,HLFS,8)=$S(X1]"":X1,1:HLQ) ; Date Ruled Incomp

 ;

QUIT ; 

 Q "ZGD"_HLFS_$G(VAFY)

 ;

GUAR ; Corresponding nodes for guarantor type and ZIPZ+4 field piece.

 ;;.29;;13

 ;;.291;;12

VAFHLZGD  ;ALB/KCL/CPM - Create generic HL7 ZGD segment ; 17 Febuary 1993

 +1       ;;5.3;Registration;**33,68**;Aug 13, 1993

 +2       ;

 +3       ;

EN(DFN,VAFSTR,VAFREQ,VAFNUM) ; This generic extrinsic function was

 +1       ;                                 designed to return the HL7 ZGD

 +2       ;                                 segment.  This segment contains

 +3       ;                                 generic information pertaining to

 +4       ;                                 a patient's legal guardian.

 +5       ;

 +6       ;  Input - DFN as internal entry number of the PATIENT file.

 +7       ;          VAFSTR as string of fields requested separated by commas

 +8       ;          VAFREQ is 1 if VA guardian data is requested, 2 if Civil

 +9       ;                   guardian data is requested.

 +10      ;          VAFNUM as sequential number to add to SET ID.

 +11      ;

 +12      ;     *****Also assumes all HL7 variables returned from*****

 +13      ;          INIT^HLTRANS are defined.

 +14      ;

 +15      ; Output - String of data forming the HL7 ZGD segment.

 +16      ;

 +17       NEW VAFNODE,VAFY,X,X1

 +18       IF '$GET(DFN)!($GET(VAFSTR)']"")

               GOTO QUIT

 +19      ; Default to VA guardian

           IF $GET(VAFREQ)'=2

               SET VAFREQ=1

 +20       SET $PIECE(VAFY,HLFS,8)=""

           SET VAFSTR=","_VAFSTR_","

 +21       SET X=$PIECE($TEXT(GUAR+VAFREQ),";;",2)

           SET VAFNODE=$GET(^DPT(DFN,X))

 +22      ; Sequential number (Required field)

           SET $PIECE(VAFY,HLFS,1)=$GET(VAFNUM)+1

 +23      ; Guardian type (Required field)

           SET $PIECE(VAFY,HLFS,2)=VAFREQ

 +24      ; Guardian

           IF VAFSTR[",3,"

               SET $PIECE(VAFY,HLFS,3)=$SELECT($PIECE(VAFNODE,"^",4)]"":$PIECE(VAFNODE,"^",4),1:HLQ)

 +25      ; Guardian Institution

           IF VAFSTR[",4,"

               SET X=$PIECE(VAFNODE,"^",3)

               SET X1=$SELECT(VAFREQ=1:$PIECE($GET(^DIC(4,+X,0)),"^",1),1:X)

               SET $PIECE(VAFY,HLFS,4)=$SELECT(X1]"":X1,1:HLQ)

 +26      ; Relationship

           IF VAFSTR[",5,"

               SET $PIECE(VAFY,HLFS,5)=$SELECT($PIECE(VAFNODE,"^",5)]"":$PIECE(VAFNODE,"^",5),1:HLQ)

 +27      ; Address

           IF VAFSTR[",6,"

               SET X1=$$ADDR^VAFHLFNC($PIECE(VAFNODE,"^",6,7)_"^^"_$PIECE(VAFNODE,"^",8,9)_"^"_$PIECE(VAFNODE,"^",$PIECE($TEXT(GUAR+VAFREQ),";;",3)))

               SET $PIECE(VAFY,HLFS,6)=$SELECT(X1]"":X1,1:HLQ)

 +28      ; Phone

           IF VAFSTR[",7,"

               SET X1=$$HLPHONE^HLFNC($PIECE(VAFNODE,"^",11))

               SET $PIECE(VAFY,HLFS,7)=$SELECT(X1]"":X1,1:HLQ)

 +29      ; Date Ruled Incomp

           IF VAFSTR[",8,"

               SET X1=$$HLDATE^HLFNC($PIECE($GET(^DPT(DFN,.29)),"^",VAFREQ))

               SET $PIECE(VAFY,HLFS,8)=$SELECT(X1]"":X1,1:HLQ)

 +30      ;

QUIT      ; 

 +1        QUIT "ZGD"_HLFS_$GET(VAFY)

 +2       ;

GUAR      ; Corresponding nodes for guarantor type and ZIPZ+4 field piece.

 +1       ;;.29;;13

 +2       ;;.291;;12