Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUPSORG

XUPSORG.m

Go to the documentation of this file.
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