- 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 Feb 18, 2025@23:38:08 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