VAFHLRO2.m

VAFHLRO2 ;BP/JRP - BUILD OUTPATIENT HL7 ROLE SEGMENT;11/18/1997 ; 7/3/01 4:09pm

 ;;5.3;Registration;**160,215,389**;Aug 13, 1993

 ;

 ; ** Do not call this routine directly  **

 ; ** Use supported call OUTPAT^VAFHLROL **

 ;

OUTPAT ;Build role segment for transmission of outpatient data

 ;

 ;Input  : As defined in OUTPAT^VAFHLROL

 ;Output : As defined in OUTPAT^VAFHLROL

 ;Notes  : Existance & validity of input assumed

 ;       : Refer to OUTPAT^VAFHLROL for details

 ;

 ;Declare variables

 N PTR200,CODEONLY,INSTID,ACTION,ROLE,ALTROLE,PERSON,TMP,RDATE

 N VAFHLROL,CMPSEP,REPSEP,ESCSEP,SUBSEP

 ;Break out individual seperators from encoding characters

 S CMPSEP=$E(ENCODE,1)

 S REPSEP=$E(ENCODE,2)

 S ESCSEP=$E(ENCODE,3)

 S SUBSEP=$E(ENCODE,4)

 ;Initialize output array

 K @OUTARR S @OUTARR@(0)=""

 ;Get pointer to provider out of parameter array

 S PTR200=+$G(@PARAM@("PTR200"))

 S:('$D(^VA(200,PTR200,0))) PTR200=0

 ;Get internal/external flag

 S CODEONLY=+$G(@PARAM@("CODEONLY"))

 ;Build segment into temporary location

 S VAFHLROL(0)="ROL"

S1 ;Role Instance ID (seq #1)

 S INSTID=$G(@PARAM@("INSTID"),NULL)

 S TMP=$P(INSTID,CMPSEP,1)

 D:((TMP=NULL)!(TMP="")) ERROR^VAFHLRO1(1,OUTARR,"could not be determined")

 S VAFHLROL(1)=FLDSEP_INSTID

S2 ;Action Code (seq #2)

 S ACTION=$G(@PARAM@("ACTION"),NULL)

 S TMP=",AD,UP,DE,CO,LI,UN,UC,"

 I (TMP'[(","_ACTION_",")) D

 .I ((ACTION=NULL)!(ACTION="")) D ERROR^VAFHLRO1(2,OUTARR,"could not be determined") Q

 .D ERROR^VAFHLRO1(2,OUTARR,"was not valid")

 S VAFHLROL(2)=FLDSEP_ACTION

S3 ;Role (seq #3, comp #1 - 3)

 I ($D(@PARAM@("ROLE"))) D  G S3C4

 .;Use input value

 .S ROLE=$G(@PARAM@("ROLE"),NULL)

 .I ((ROLE="")!(ROLE=NULL)) D ERROR^VAFHLRO1(3,OUTARR,"could not be determined")

 .S TMP=$P(ROLE,CMPSEP,1)

 .S:(TMP="") TMP=NULL

 .S VAFHLROL(3,1)=FLDSEP_TMP

 .S TMP=$P(ROLE,CMPSEP,2)

 .S:(TMP="") TMP=NULL

 .S VAFHLROL(3,2)=CMPSEP_TMP

 .S TMP=$P(ROLE,CMPSEP,3)

 .S:(TMP="") TMP=NULL

 .S VAFHLROL(3,3)=CMPSEP_TMP

 ;Calculate value

 I ('PTR200) D  G S3C4

 .D ERROR^VAFHLRO1(3,OUTARR,"could not be determined")

 .S VAFHLROL(3)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL

 K ROLE S RDATE=$G(@PARAM@("RDATE"))

 D ROLE^VAFHLRO3(PTR200,"ROLE",NULL,RDATE)

 I ('$D(ROLE)) D  G S3C4

 .D ERROR^VAFHLRO1(3,OUTARR,"could not be determined")

 .S VAFHLROL(3)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL

 ;Strip out external values

 I (CODEONLY) F TMP=1:1:3 S ROLE(2,TMP)=NULL

 ;Copy and add appropriate seperators

 ; (Convert any HL7 characters into spaces)

 S TMP=FLDSEP_ENCODE

 S VAFHLROL(3,1)=FLDSEP_$TR(ROLE(1),TMP,"      ")

 S VAFHLROL(3,2,1)=CMPSEP_$TR(ROLE(2,1),TMP,"     ")

 S VAFHLROL(3,2,2)=SUBSEP_$TR(ROLE(2,2),TMP,"     ")

 S VAFHLROL(3,2,3)=SUBSEP_$TR(ROLE(2,3),TMP,"     ")

 S VAFHLROL(3,3)=CMPSEP_$TR(ROLE(3),TMP,"     ")

S3C4 ;Alternate Role (seq #3, comp #4 - 6)

 I ('$D(@PARAM@("ALTROLE"))) D  G S4

 .S VAFHLROL(3,4)=CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL

 ;Use input value

 S TMP=NULL_CMPSEP_NULL_CMPSEP_NULL

 S ALTROLE=$G(@PARAM@("ALTROLE"),TMP)

 S:(ALTROLE="") ALTROLE=TMP

 S TMP=$P(ALTROLE,CMPSEP,1)

 S:(TMP="") TMP=NULL

 S VAFHLROL(3,4)=CMPSEP_TMP

 S TMP=$P(ALTROLE,CMPSEP,2)

 S:(TMP="") TMP=NULL

 S VAFHLROL(3,5)=CMPSEP_TMP

 S TMP=$P(ALTROLE,CMPSEP,3)

 S:(TMP="") TMP=NULL

 S VAFHLROL(3,6)=CMPSEP_TMP

S4 ;Role Person (seq #4)

 I ($D(@PARAM@("PERSON"))) D  G DONE

 .;Use input value

 .S PERSON=$G(@PARAM@("PERSON"),NULL)

 .I ((PERSON="")!(PERSON=NULL)) D ERROR^VAFHLRO1(4,OUTARR,"could not be determined")

 .S TMP=$P(PERSON,CMPSEP,1)

 .S:(TMP="") TMP=NULL

 .S VAFHLROL(4,1)=FLDSEP_TMP

 .S TMP=$P(PERSON,CMPSEP,2)

 .S:(TMP="") TMP=NULL

 .S VAFHLROL(4,2)=CMPSEP_TMP

 .S TMP=$P(PERSON,CMPSEP,3)

 .S:(TMP="") TMP=NULL

 .S VAFHLROL(4,3)=CMPSEP_TMP

 .S TMP=$P(PERSON,CMPSEP,4)

 .S:(TMP="") TMP=NULL

 .S VAFHLROL(4,4)=CMPSEP_TMP

 .S TMP=$P(PERSON,CMPSEP,5)

 .S:(TMP="") TMP=NULL

 .S VAFHLROL(4,5)=CMPSEP_TMP

 .S TMP=$P(PERSON,CMPSEP,6)

 .S:(TMP="") TMP=NULL

 .S VAFHLROL(4,6)=CMPSEP_TMP

 .S TMP=$P(PERSON,CMPSEP,7)

 .S:(TMP="") TMP=NULL

 .S VAFHLROL(4,7)=CMPSEP_TMP

 .S TMP=$P(PERSON,CMPSEP,8)

 .S:(TMP="") TMP=NULL

 .S VAFHLROL(4,8)=CMPSEP_TMP

 ;Calculate value

 I ('PTR200) D  G DONE

 .D ERROR^VAFHLRO1(4,OUTARR,"could not be determined")

 .S VAFHLROL(4)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL

 K PERSON D PERSON^VAFHLRO3(PTR200,"PERSON",NULL)

 I ('$D(PERSON)) D  G DONE

 .D ERROR^VAFHLRO1(4,OUTARR,"could not be determined")

 .S VAFHLROL(4)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL

 ;Strip out external values

 I (CODEONLY) F TMP=2:1:7 S PERSON(1,TMP)=NULL

 ;Copy and add appropriate seperators

 ; (Convert any HL7 characters into spaces)

 S TMP=FLDSEP_ENCODE

 S VAFHLROL(4,1,1,1)=FLDSEP_$TR(PERSON(1,1,1),TMP,"     ")

 S VAFHLROL(4,1,1,2)=SUBSEP_$TR(PERSON(1,1,2),TMP,"     ")

 S VAFHLROL(4,1,2)=CMPSEP_$TR(PERSON(1,2),TMP,"     ")

 S VAFHLROL(4,1,3)=CMPSEP_$TR(PERSON(1,3),TMP,"     ")

 S VAFHLROL(4,1,4)=CMPSEP_$TR(PERSON(1,4),TMP,"     ")

 S VAFHLROL(4,1,5)=CMPSEP_$TR(PERSON(1,5),TMP,"     ")

 S VAFHLROL(4,1,6)=CMPSEP_$TR(PERSON(1,6),TMP,"     ")

 S VAFHLROL(4,1,7)=CMPSEP_$TR(PERSON(1,7),TMP,"     ")

 S VAFHLROL(4,1,8)=CMPSEP_$TR(PERSON(1,8),TMP,"     ")

 S VAFHLROL(4,2,1)=REPSEP_$TR(PERSON(2,1),TMP,"     ")

 F TMP=1:1:7 S VAFHLROL(4,2,TMP+1)=CMPSEP_$TR(PERSON(2,TMP+1),TMP,"    ")

 S VAFHLROL(4,2,9)=CMPSEP_$TR(PERSON(2,9),TMP,"     ")

DONE ;Collapse into output location

 D FIXLEN^VAFHLRO1("VAFHLROL",OUTARR,MAXLEN,0)

 ;Done

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VAFHLRO2   5633     printed  Feb 19, 2025@00:29:14                                                                                                                                                                                                    Page 2

VAFHLRO2  ;BP/JRP - BUILD OUTPATIENT HL7 ROLE SEGMENT;11/18/1997 ; 7/3/01 4:09pm

 +1       ;;5.3;Registration;**160,215,389**;Aug 13, 1993

 +2       ;

 +3       ; ** Do not call this routine directly  **

 +4       ; ** Use supported call OUTPAT^VAFHLROL **

 +5       ;

OUTPAT    ;Build role segment for transmission of outpatient data

 +1       ;

 +2       ;Input  : As defined in OUTPAT^VAFHLROL

 +3       ;Output : As defined in OUTPAT^VAFHLROL

 +4       ;Notes  : Existance & validity of input assumed

 +5       ;       : Refer to OUTPAT^VAFHLROL for details

 +6       ;

 +7       ;Declare variables

 +8        NEW PTR200,CODEONLY,INSTID,ACTION,ROLE,ALTROLE,PERSON,TMP,RDATE

 +9        NEW VAFHLROL,CMPSEP,REPSEP,ESCSEP,SUBSEP

 +10      ;Break out individual seperators from encoding characters

 +11       SET CMPSEP=$EXTRACT(ENCODE,1)

 +12       SET REPSEP=$EXTRACT(ENCODE,2)

 +13       SET ESCSEP=$EXTRACT(ENCODE,3)

 +14       SET SUBSEP=$EXTRACT(ENCODE,4)

 +15      ;Initialize output array

 +16       KILL @OUTARR

           SET @OUTARR@(0)=""

 +17      ;Get pointer to provider out of parameter array

 +18       SET PTR200=+$GET(@PARAM@("PTR200"))

 +19       if ('$DATA(^VA(200,PTR200,0)))

               SET PTR200=0

 +20      ;Get internal/external flag

 +21       SET CODEONLY=+$GET(@PARAM@("CODEONLY"))

 +22      ;Build segment into temporary location

 +23       SET VAFHLROL(0)="ROL"

S1        ;Role Instance ID (seq #1)

 +1        SET INSTID=$GET(@PARAM@("INSTID"),NULL)

 +2        SET TMP=$PIECE(INSTID,CMPSEP,1)

 +3        if ((TMP=NULL)!(TMP=""))

               DO ERROR^VAFHLRO1(1,OUTARR,"could not be determined")

 +4        SET VAFHLROL(1)=FLDSEP_INSTID

S2        ;Action Code (seq #2)

 +1        SET ACTION=$GET(@PARAM@("ACTION"),NULL)

 +2        SET TMP=",AD,UP,DE,CO,LI,UN,UC,"

 +3        IF (TMP'[(","_ACTION_","))

               Begin DoDot:1

 +4                IF ((ACTION=NULL)!(ACTION=""))

                       DO ERROR^VAFHLRO1(2,OUTARR,"could not be determined")

                       QUIT 

 +5                DO ERROR^VAFHLRO1(2,OUTARR,"was not valid")

               End DoDot:1

 +6        SET VAFHLROL(2)=FLDSEP_ACTION

S3        ;Role (seq #3, comp #1 - 3)

 +1        IF ($DATA(@PARAM@("ROLE")))

               Begin DoDot:1

 +2       ;Use input value

 +3                SET ROLE=$GET(@PARAM@("ROLE"),NULL)

 +4                IF ((ROLE="")!(ROLE=NULL))

                       DO ERROR^VAFHLRO1(3,OUTARR,"could not be determined")

 +5                SET TMP=$PIECE(ROLE,CMPSEP,1)

 +6                if (TMP="")

                       SET TMP=NULL

 +7                SET VAFHLROL(3,1)=FLDSEP_TMP

 +8                SET TMP=$PIECE(ROLE,CMPSEP,2)

 +9                if (TMP="")

                       SET TMP=NULL

 +10               SET VAFHLROL(3,2)=CMPSEP_TMP

 +11               SET TMP=$PIECE(ROLE,CMPSEP,3)

 +12               if (TMP="")

                       SET TMP=NULL

 +13               SET VAFHLROL(3,3)=CMPSEP_TMP

               End DoDot:1

               GOTO S3C4

 +14      ;Calculate value

 +15       IF ('PTR200)

               Begin DoDot:1

 +16               DO ERROR^VAFHLRO1(3,OUTARR,"could not be determined")

 +17               SET VAFHLROL(3)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL

               End DoDot:1

               GOTO S3C4

 +18       KILL ROLE

           SET RDATE=$GET(@PARAM@("RDATE"))

 +19       DO ROLE^VAFHLRO3(PTR200,"ROLE",NULL,RDATE)

 +20       IF ('$DATA(ROLE))

               Begin DoDot:1

 +21               DO ERROR^VAFHLRO1(3,OUTARR,"could not be determined")

 +22               SET VAFHLROL(3)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL

               End DoDot:1

               GOTO S3C4

 +23      ;Strip out external values

 +24       IF (CODEONLY)

               FOR TMP=1:1:3

                   SET ROLE(2,TMP)=NULL

 +25      ;Copy and add appropriate seperators

 +26      ; (Convert any HL7 characters into spaces)

 +27       SET TMP=FLDSEP_ENCODE

 +28       SET VAFHLROL(3,1)=FLDSEP_$TRANSLATE(ROLE(1),TMP,"      ")

 +29       SET VAFHLROL(3,2,1)=CMPSEP_$TRANSLATE(ROLE(2,1),TMP,"     ")

 +30       SET VAFHLROL(3,2,2)=SUBSEP_$TRANSLATE(ROLE(2,2),TMP,"     ")

 +31       SET VAFHLROL(3,2,3)=SUBSEP_$TRANSLATE(ROLE(2,3),TMP,"     ")

 +32       SET VAFHLROL(3,3)=CMPSEP_$TRANSLATE(ROLE(3),TMP,"     ")

S3C4      ;Alternate Role (seq #3, comp #4 - 6)

 +1        IF ('$DATA(@PARAM@("ALTROLE")))

               Begin DoDot:1

 +2                SET VAFHLROL(3,4)=CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL

               End DoDot:1

               GOTO S4

 +3       ;Use input value

 +4        SET TMP=NULL_CMPSEP_NULL_CMPSEP_NULL

 +5        SET ALTROLE=$GET(@PARAM@("ALTROLE"),TMP)

 +6        if (ALTROLE="")

               SET ALTROLE=TMP

 +7        SET TMP=$PIECE(ALTROLE,CMPSEP,1)

 +8        if (TMP="")

               SET TMP=NULL

 +9        SET VAFHLROL(3,4)=CMPSEP_TMP

 +10       SET TMP=$PIECE(ALTROLE,CMPSEP,2)

 +11       if (TMP="")

               SET TMP=NULL

 +12       SET VAFHLROL(3,5)=CMPSEP_TMP

 +13       SET TMP=$PIECE(ALTROLE,CMPSEP,3)

 +14       if (TMP="")

               SET TMP=NULL

 +15       SET VAFHLROL(3,6)=CMPSEP_TMP

S4        ;Role Person (seq #4)

 +1        IF ($DATA(@PARAM@("PERSON")))

               Begin DoDot:1

 +2       ;Use input value

 +3                SET PERSON=$GET(@PARAM@("PERSON"),NULL)

 +4                IF ((PERSON="")!(PERSON=NULL))

                       DO ERROR^VAFHLRO1(4,OUTARR,"could not be determined")

 +5                SET TMP=$PIECE(PERSON,CMPSEP,1)

 +6                if (TMP="")

                       SET TMP=NULL

 +7                SET VAFHLROL(4,1)=FLDSEP_TMP

 +8                SET TMP=$PIECE(PERSON,CMPSEP,2)

 +9                if (TMP="")

                       SET TMP=NULL

 +10               SET VAFHLROL(4,2)=CMPSEP_TMP

 +11               SET TMP=$PIECE(PERSON,CMPSEP,3)

 +12               if (TMP="")

                       SET TMP=NULL

 +13               SET VAFHLROL(4,3)=CMPSEP_TMP

 +14               SET TMP=$PIECE(PERSON,CMPSEP,4)

 +15               if (TMP="")

                       SET TMP=NULL

 +16               SET VAFHLROL(4,4)=CMPSEP_TMP

 +17               SET TMP=$PIECE(PERSON,CMPSEP,5)

 +18               if (TMP="")

                       SET TMP=NULL

 +19               SET VAFHLROL(4,5)=CMPSEP_TMP

 +20               SET TMP=$PIECE(PERSON,CMPSEP,6)

 +21               if (TMP="")

                       SET TMP=NULL

 +22               SET VAFHLROL(4,6)=CMPSEP_TMP

 +23               SET TMP=$PIECE(PERSON,CMPSEP,7)

 +24               if (TMP="")

                       SET TMP=NULL

 +25               SET VAFHLROL(4,7)=CMPSEP_TMP

 +26               SET TMP=$PIECE(PERSON,CMPSEP,8)

 +27               if (TMP="")

                       SET TMP=NULL

 +28               SET VAFHLROL(4,8)=CMPSEP_TMP

               End DoDot:1

               GOTO DONE

 +29      ;Calculate value

 +30       IF ('PTR200)

               Begin DoDot:1

 +31               DO ERROR^VAFHLRO1(4,OUTARR,"could not be determined")

 +32               SET VAFHLROL(4)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL

               End DoDot:1

               GOTO DONE

 +33       KILL PERSON

           DO PERSON^VAFHLRO3(PTR200,"PERSON",NULL)

 +34       IF ('$DATA(PERSON))

               Begin DoDot:1

 +35               DO ERROR^VAFHLRO1(4,OUTARR,"could not be determined")

 +36               SET VAFHLROL(4)=FLDSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL_CMPSEP_NULL

               End DoDot:1

               GOTO DONE

 +37      ;Strip out external values

 +38       IF (CODEONLY)

               FOR TMP=2:1:7

                   SET PERSON(1,TMP)=NULL

 +39      ;Copy and add appropriate seperators

 +40      ; (Convert any HL7 characters into spaces)

 +41       SET TMP=FLDSEP_ENCODE

 +42       SET VAFHLROL(4,1,1,1)=FLDSEP_$TRANSLATE(PERSON(1,1,1),TMP,"     ")

 +43       SET VAFHLROL(4,1,1,2)=SUBSEP_$TRANSLATE(PERSON(1,1,2),TMP,"     ")

 +44       SET VAFHLROL(4,1,2)=CMPSEP_$TRANSLATE(PERSON(1,2),TMP,"     ")

 +45       SET VAFHLROL(4,1,3)=CMPSEP_$TRANSLATE(PERSON(1,3),TMP,"     ")

 +46       SET VAFHLROL(4,1,4)=CMPSEP_$TRANSLATE(PERSON(1,4),TMP,"     ")

 +47       SET VAFHLROL(4,1,5)=CMPSEP_$TRANSLATE(PERSON(1,5),TMP,"     ")

 +48       SET VAFHLROL(4,1,6)=CMPSEP_$TRANSLATE(PERSON(1,6),TMP,"     ")

 +49       SET VAFHLROL(4,1,7)=CMPSEP_$TRANSLATE(PERSON(1,7),TMP,"     ")

 +50       SET VAFHLROL(4,1,8)=CMPSEP_$TRANSLATE(PERSON(1,8),TMP,"     ")

 +51       SET VAFHLROL(4,2,1)=REPSEP_$TRANSLATE(PERSON(2,1),TMP,"     ")

 +52       FOR TMP=1:1:7

               SET VAFHLROL(4,2,TMP+1)=CMPSEP_$TRANSLATE(PERSON(2,TMP+1),TMP,"    ")

 +53       SET VAFHLROL(4,2,9)=CMPSEP_$TRANSLATE(PERSON(2,9),TMP,"     ")

DONE      ;Collapse into output location

 +1        DO FIXLEN^VAFHLRO1("VAFHLROL",OUTARR,MAXLEN,0)

 +2       ;Done

 +3        QUIT