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

PRSMPI.m

Go to the documentation of this file.
  1. PRSMPI ;ALB/CMC-TRIGGER X-REF ON PAID FIELDS FOR MPI & STF SEG BUILDER ;8/5/2010
  1. ;;4.0;PAID;**128**;Sep 21, 1995;Build 3
  1. ;
  1. XREF(DA) ;TRIGGER TO SET THE REQUIRES TRANSMISSION FIELD if the PAID Enumeration process has started
  1. ;8989.3,901 PAID Enumeration Started MPI;2 DATE
  1. N IEN,FDA,PRSERR
  1. S IEN=$O(^XTV(8989.3,0))
  1. Q:$P($G(^XTV(8989.3,IEN,"MPI")),"^",2)=""
  1. ;enumeration has started so set the Requires Transmission field in PAID for this Record
  1. S FDA(450,DA_",",902)="Y"
  1. D FILE^DIE("E","FDA","PRSERR")
  1. ;what to do if can't set the field???
  1. Q
  1. ;
  1. GET(EN,ARRAY) ;
  1. ;EN is the internal entry for the person in file 200
  1. ;returned is 0 or -1^error message
  1. ;if returned value is 0 then ARRAY will also be defined with the data values
  1. N CNT,COR,NAME2,NAME,ERROR
  1. I 'EN S ERROR="-1^Invalid parameter - no correlation ien passed." Q ERROR
  1. M COR(EN)=^PRSPC(EN)
  1. I '$D(COR(EN)) S ERROR="-1^Correlation doesn't exist." Q ERROR
  1. S ARRAY("SourceSystemIEN")=$P($$SITE^VASITE(),"^") ;facility ien
  1. S ARRAY("SourceSystemID")=$P($$SITE^VASITE(),"^",3) ;facility station number
  1. S ARRAY("SourceID")=EN ;duz
  1. S NAME2=$P(COR(EN,0),"^")
  1. S NAME=$$HLNAME^XLFNAME(.NAME2,"","^")
  1. S ARRAY("Surname")=$P(NAME,"^") ;surname
  1. S ARRAY("FirstName")=$P(NAME,"^",2) ;first name
  1. S ARRAY("MiddleName")=$P(NAME,"^",3) ;middle name
  1. S ARRAY("Prefix")="" ;PREFIX IS NOT STORED IN PAID EMPLOYEE
  1. S ARRAY("Suffix")=$P(NAME,"^",4) ;suffix
  1. S ARRAY("DOB")=$P($G(COR(EN,0)),"^",33) ;dob
  1. S ARRAY("Gender")=$P($G(COR(EN,0)),"^",32) ;gender
  1. S ARRAY("SSN")=$P($G(COR(EN,0)),"^",9) ;ssn
  1. S ARRAY("ResAddL1")=$P($G(COR(EN,"ADD")),"^",7) ;street line 1
  1. S ARRAY("ResAddL2")=$P($G(COR(EN,"ADD")),"^",8) ;street line 2
  1. S ARRAY("ResAddL3")=$P($G(COR(EN,"ADD")),"^",9) ;street line 3
  1. S ARRAY("ResAddCity")="" ;city is not defined per say in PAID file
  1. S ARRAY("ResAddState")=$P($G(COR(EN,"ADD")),"^",6) ;state
  1. S ARRAY("ResAddZip4")=$P($G(COR(EN,"ADD")),"^",10) ;zip
  1. S ARRAY("NPIEN")=$P($G(^PRSPC(EN,200)),"^") ;NEW PERSON FILE IEN
  1. S ARRAY("EnumerateStart")=$P($G(^PRSPC(EN,"MPI")),"^") ;Enumeration Initiated
  1. S ARRAY("EnumerateComp")=$P($G(^PRSPC(EN,"MPI")),"^",2) ;Enumeration Completed
  1. Q 0
  1. STF(PRSSIEN,HL,PRSSTR) ; STF segment builder for PAID Employee (#450)
  1. ;at this moment fields 2, 3, 5, 6, 10 and 11 will be populated
  1. ;seq 2 may contain SSN, PAID IEN, and New Person IEN as a repeating field
  1. ;PRSSIEN is the IEN in PAID Employee that data is being pulled from
  1. ;HL is the array name containing the HL7 array variables
  1. ;PRSSTR is the list of fields that can be populated in the STF segment
  1. ;Output:
  1. ;PRSSTF - First 245 characters
  1. ;PRSSTF(1..n)=continuation nodes if results > 245 characters
  1. ;
  1. I $G(PRSSTR)="" S PRSSTR="2,3,4,5,10,11"
  1. N HLFS,COMP,HLES,SUBCOMP,PRSSRCTR,PRSSSUB1,PRSSSUB2,PRSSSUB3,ARRAY,TMP,TADDR,PRSSSEG,PRSSREC,PRSSSTF
  1. S HLFS=HL("FS"),COMP=$E(HL("ECH")),HLES=$E(HL("ECH"),2),SUBCOMP=$E(HL("ECH"),4)
  1. S TMP=$$GET(PRSSIEN,.ARRAY)
  1. Q:'$D(ARRAY) "-1^No entry"
  1. ;SEQUENCE 2
  1. I PRSSTR["2," D
  1. .S (PRSSSUB1,PRSSSUB2,PRSSSUB3)="",PRSSRCTR=0
  1. .;IEN file 450
  1. .S PRSSSUB1=PRSSIEN_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"EI"_COMP
  1. .S PRSSSUB1=PRSSSUB1_"VA FACILITY ID"_SUBCOMP_$P($$SITE^VASITE(),"^",3)_SUBCOMP_"L"_COMP_COMP
  1. .S PRSSRCTR=PRSSRCTR+1
  1. .S PRSSSEG(2,PRSSRCTR)=PRSSSUB1
  1. .;SSN
  1. .S PRSSSUB2=$S(ARRAY("SSN")]"":ARRAY("SSN"),1:HL("Q"))_COMP_COMP_COMP_"USSSA"_SUBCOMP_SUBCOMP_"0363"_COMP_"SS"
  1. .S PRSSSUB2=PRSSSUB2_COMP_"VA FACILITY ID"_SUBCOMP_$P($$SITE^VASITE(),"^",3)_SUBCOMP_"L"
  1. .S PRSSRCTR=PRSSRCTR+1
  1. .S PRSSSEG(2,PRSSRCTR)=PRSSSUB2
  1. .;NEW PERSON POINTER
  1. .S PRSSSUB3=$S(ARRAY("NPIEN")]"":ARRAY("NPIEN"),1:HL("Q"))_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP
  1. .S PRSSSUB3=PRSSSUB3_"PN"_COMP_"VA FACILITY ID"_SUBCOMP_$P($$SITE^VASITE(),"^",3)_SUBCOMP_"L"_COMP_COMP
  1. .S PRSSRCTR=PRSSRCTR+1
  1. .S PRSSSEG(2,PRSSRCTR)=PRSSSUB3
  1. ;NAME
  1. I PRSSTR["3," D ;get name data
  1. .;name last^first^middle^suffix^prefix^^"L" for legal
  1. .S PRSSSEG(3)=$S(ARRAY("Surname")'="":ARRAY("Surname"),1:HL("Q"))_COMP_$S($G(ARRAY("FirstName"))'="":$G(ARRAY("FirstName")),1:HL("Q"))_COMP
  1. .S PRSSSEG(3)=PRSSSEG(3)_$S($G(ARRAY("MiddleName"))'="":$G(ARRAY("MiddleName")),1:HL("Q"))_COMP_$S($G(ARRAY("Suffix"))'="":$G(ARRAY("Suffix")),1:HL("Q"))_COMP
  1. .S PRSSSEG(3)=PRSSSEG(3)_$S($G(ARRAY("Prefix"))'="":$G(ARRAY("Prefix")),1:HL("Q"))_COMP_COMP_"L"
  1. ;SEX
  1. I PRSSTR["5," D ;get sex
  1. .S PRSSSEG(5)=$S($G(ARRAY("Gender"))'="":$G(ARRAY("Gender")),1:HL("Q"))
  1. ;DOB
  1. I PRSSTR["6," D ;get dob
  1. .S PRSSSEG(6)=$S($G(ARRAY("DOB"))'="":$$HLDATE^HLFNC($G(ARRAY("DOB"))),1:HL("Q"))
  1. ;Address
  1. I PRSSTR[",11" D
  1. .N PRSSA,HL7STRG
  1. .S HL7STRG=$G(ARRAY("ResAddL1"))
  1. .I HL7STRG'="" D HL7TXT(.HL7STRG,.HL,HLES)
  1. .S $P(TADDR,COMP)=$S($G(HL7STRG)'="":HL7STRG,1:HL("Q"))
  1. .S HL7STRG=$G(ARRAY("ResAddL2")) D HL7TXT(.HL7STRG,.HL,HLES)
  1. .S $P(TADDR,COMP,2)=$S($G(HL7STRG)'="":HL7STRG,1:HL("Q"))
  1. .S HL7STRG=$G(ARRAY("ResAddCity")) D HL7TXT(.HL7STRG,.HL,HLES)
  1. .S $P(TADDR,COMP,3)=$S($G(HL7STRG)'="":HL7STRG,1:HL("Q"))
  1. .S $P(TADDR,COMP,4)=$S($G(ARRAY("ResAddState"))'="":$G(ARRAY("ResAddState")),1:HL("Q"))
  1. .S $P(TADDR,COMP,5)=$S($G(ARRAY("ResAddZip4"))'="":ARRAY("ResAddZip4"),1:HL("Q"))
  1. .S HL7STRG=$G(ARRAY("ResAddL3")) D HL7TXT(.HL7STRG,.HL,HLES)
  1. .S $P(TADDR,COMP,8)=$S($G(HL7STRG)'="":HL7STRG,1:HL("Q"))
  1. .;Country set to null - not used by PSIM
  1. .S $P(TADDR,COMP,6)=""
  1. .;Address type set to P for permanent
  1. .S $P(TADDR,COMP,7)="P"
  1. .S PRSSSEG(11)=TADDR
  1. ;
  1. D MAKEIT^PRSHL7B("STF",.PRSSSEG,.PRSSREC,.PRSSSTF)
  1. Q PRSSREC
  1. ;
  1. HL7TXT(HL7STRG,HL,HLES) ; Replace occurrences of embedded HL7 delimiters with HL7 escape sequence
  1. ; Inputs: HL7STRG - Data string to be checked
  1. ; HL("ECH") - HL7 delimiter string
  1. ; Delimiters MUST be in the following order: Escape, Field, Component, Repeat, Subcomponent
  1. ; Example: \^~|&
  1. ; Output: HL7XTRG - Data string with escape sequence added (if needed)
  1. N OCHR,RCHR,RCHRI,TYPE,I,HLES2
  1. I $G(HL("COMP"))="" S HL("COMP")=$E(HL("ECH"),1),HL("REP")=$E(HL("ECH"),2),HL("SUBCOMP")=$E(HL("ECH"),4)
  1. ; Set HL7 escape char
  1. S HLES2=HLES_HL("FS")_HL("COMP")_HL("REP")_HL("SUBCOMP")
  1. ; Search for occurrence of each delimiter and replace it with "\<type>\"
  1. F TYPE="E","F","C","R","S" D
  1. .S RCHRI=$S(TYPE="E":1,TYPE="F":2,TYPE="C":3,TYPE="R":4,TYPE="S":5)
  1. .; OCHR=original char, RCHR=replacement char
  1. .S OCHR=$E(HLES2,RCHRI),RCHR=$E("EFSRT",RCHRI) Q:'$F(HL7STRG,OCHR)
  1. .F I=1:1 Q:$E(HL7STRG,I)="" I $E(HL7STRG,I)=OCHR S HL7STRG=$E(HL7STRG,1,I-1)_HLES_RCHR_HLES_$E(HL7STRG,I+1,999),I=I+2
  1. Q