XUPSORG ;ALB/CMC - Build ORG segment;Aug 6, 2010
 ;;8.0;KERNEL;**551**;Jul 10, 1995;Build 2
EN(XUDUZ,HL,XUORG) ; ORG SEGMENT FOR VISITOR FIELDS 1 AND 5
 ;INPUT:  XUDUZ - IEN in file 200
 ;HL array variables
 ;OUTPUT: XUORG CONTAINING ORG SEGMENT(S)
 ;XUORG=-1^ERROR MESSAGE IF CAN'T BUILD ORG SEGMENT
 N NUM
 K XUORG
 I XUDUZ=""!('$D(HL)) S XUORG="-1^MISSING PARAMETERS" G QUIT ;missing parameter
 ;
 S NUM=1
 I '$D(^VA(200,XUDUZ,8910)) S $P(XUORG(NUM),HL("FS"),1)="ORG"_HL("FS")_NUM_HL("FS") G QUIT
 ;have visitor records
 N IEN,COMP,SUBCOMP,VIS,NODE
 S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4)
 S IEN=0 F  S IEN=$O(^VA(200,XUDUZ,8910,IEN)) Q:'IEN  D
 .S NODE=$G(^VA(200,XUDUZ,8910,IEN,0))
 .;VISITOR DATA WILL BE: 
 .;DUZ AT HOME SITE (0;3)^<CHECK DIGIT>^<CHECK DIGIT SCHEME>^ASSIGNING AUTHORTY^ID TYPE CODE^
 .;ASSIGNING FACILITY^EFFECTIVE DATE^EXPIRATION DATE (TODAY)
 .S $P(XUORG(NUM),HL("FS"),1)="ORG"_HL("FS")_NUM_HL("FS")
 .S VIS=$P(NODE,"^",3)_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"PN"_COMP
 .S VIS=VIS_"VA FACILITY ID"_SUBCOMP_$P(NODE,"^")_SUBCOMP_"L"_COMP_COMP
 .S $P(XUORG(NUM),HL("FS"),6)=VIS
 .S NUM=NUM+1
QUIT Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUPSORG   1172     printed  Sep 23, 2025@19:47:57                                                                                                                                                                                                     Page 2
XUPSORG   ;ALB/CMC - Build ORG segment;Aug 6, 2010
 +1       ;;8.0;KERNEL;**551**;Jul 10, 1995;Build 2
EN(XUDUZ,HL,XUORG) ; ORG SEGMENT FOR VISITOR FIELDS 1 AND 5
 +1       ;INPUT:  XUDUZ - IEN in file 200
 +2       ;HL array variables
 +3       ;OUTPUT: XUORG CONTAINING ORG SEGMENT(S)
 +4       ;XUORG=-1^ERROR MESSAGE IF CAN'T BUILD ORG SEGMENT
 +5        NEW NUM
 +6        KILL XUORG
 +7       ;missing parameter
           IF XUDUZ=""!('$DATA(HL))
               SET XUORG="-1^MISSING PARAMETERS"
               GOTO QUIT
 +8       ;
 +9        SET NUM=1
 +10       IF '$DATA(^VA(200,XUDUZ,8910))
               SET $PIECE(XUORG(NUM),HL("FS"),1)="ORG"_HL("FS")_NUM_HL("FS")
               GOTO QUIT
 +11      ;have visitor records
 +12       NEW IEN,COMP,SUBCOMP,VIS,NODE
 +13       SET COMP=$EXTRACT(HL("ECH"),1)
           SET SUBCOMP=$EXTRACT(HL("ECH"),4)
 +14       SET IEN=0
           FOR 
               SET IEN=$ORDER(^VA(200,XUDUZ,8910,IEN))
               if 'IEN
                   QUIT 
               Begin DoDot:1
 +15               SET NODE=$GET(^VA(200,XUDUZ,8910,IEN,0))
 +16      ;VISITOR DATA WILL BE: 
 +17      ;DUZ AT HOME SITE (0;3)^<CHECK DIGIT>^<CHECK DIGIT SCHEME>^ASSIGNING AUTHORTY^ID TYPE CODE^
 +18      ;ASSIGNING FACILITY^EFFECTIVE DATE^EXPIRATION DATE (TODAY)
 +19               SET $PIECE(XUORG(NUM),HL("FS"),1)="ORG"_HL("FS")_NUM_HL("FS")
 +20               SET VIS=$PIECE(NODE,"^",3)_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"PN"_COMP
 +21               SET VIS=VIS_"VA FACILITY ID"_SUBCOMP_$PIECE(NODE,"^")_SUBCOMP_"L"_COMP_COMP
 +22               SET $PIECE(XUORG(NUM),HL("FS"),6)=VIS
 +23               SET NUM=NUM+1
               End DoDot:1
QUIT       QUIT