XUPSORG.m

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 ---XUPSORG   1172     printed  Apr 09, 2024@21:11:11                                                                                                                                                                                                     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