- VAFCQRY ;BIR/DLR-Query for patient demographics ;1/27/23 14:07
- ;;5.3;Registration;**428,575,627,707,863,902,926,967,1059,1092**;Aug 13, 1993;Build 1
- ;
- IN ;process in the patient query
- N IEN,HLA,VAFCCNT,ICN,CLAIM,SG,VAFCER,VAFC,DFN,STATE,CITY,SUBCOMP,COMP,REP,LVL,LVL2,VAFC,SSN,SAVEDFN
- S VAFCCNT=1,VAFCER=1
- F VAFC=1:1 X HLNEXT Q:HLQUIT'>0 S SG=$E(HLNODE,1,3) D:$T(@SG)]"" @SG
- S SAVEDFN=$G(DFN)
- D CHKID^VAFCQRY2(.ICN,.SSN,.DFN)
- I $G(DFN)'>0 D
- . ;**863 MVI_2352 if merged send back merged record info for update
- . I SAVEDFN,$D(^DPT(SAVEDFN,-9)) D Q
- .. N DFN,ICN
- .. S DFN=^DPT(SAVEDFN,-9),ICN=$$GETICN^MPIF001(+DFN)
- .. S VAFCER="-1^New Primary record "_DFN_" at site with ICN "_ICN
- . S VAFCER="-1^Unknown ICN#"_$G(ICN)_" and SSN#"_$G(SSN)
- S ^TMP("HLA",$J,VAFCCNT)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS")_$S(+$G(VAFCER)'>0:$P(VAFCER,"^",2),1:""),VAFCCNT=VAFCCNT+1
- S ^TMP("HLA",$J,VAFCCNT)=VAFCQRD,VAFCCNT=VAFCCNT+1
- I $G(VAFCER)>0 D BLDRSP(DFN,.VAFCCNT)
- D LINK^HLUTIL3(SITE,.VAFC) S IEN=$O(VAFC(0)) S HLL("LINKS",1)="^"_VAFC(IEN)
- D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA,"",.HL)
- K VAFCER,VAFCID,COMP,SITE,VAFCFS,VAFCRCV,VAFCQRD,^TMP("HLA",$J)
- Q
- ;
- RESP ;Response processing initiated from the MPI.
- Q
- ;
- ROUTE ;Routine logic initiated from the MPI.
- Q
- ;
- BLDRSP(DFN,VAFCCNT) ;
- N EVN,PID,PD1,SEQ,ERR,CNT,X,PV2,RADE,LABE,PRES
- N SIDG,ZEL,ZSP,NAMECOMP,OLD,PV1,DODF,DODD,DODOPT,DODNP,DODDISDT,SECLVL,SEXOR,SEXORD,PRON,PROND
- ;construct EVN (for TF Event Type AND Last Treatment Date)
- S SEQ="1,2" D BLDEVN(DFN,.SEQ,.EVN,.HL,"A19",.ERR) S ^TMP("HLA",$J,VAFCCNT)=EVN(1) S VAFCCNT=VAFCCNT+1
- ;construct PID
- S SEQ="ALL" D BLDPID(DFN,1,.SEQ,.PID,.HL,.ERR) S ^TMP("HLA",$J,VAFCCNT)=PID(1) S X=1,CNT=1 F S X=$O(PID(X)) Q:'X I $D(PID(X)) S ^TMP("HLA",$J,VAFCCNT,CNT)=PID(X),CNT=CNT+1
- S VAFCCNT=VAFCCNT+1
- ;construct PD1 **707
- ;S SEQ="3" D BLDPD1(DFN,.SEQ,.PD1,.HL,.ERR) S ^TMP("HLA",$J,VAFCCNT)=PD1(1)
- S PD1=$$PD1^VAFCSB I PD1'="" S ^TMP("HLA",$J,VAFCCNT)=PD1,VAFCCNT=VAFCCNT+1 ;**707
- S PV1=$$PV1^VAFCSB I PV1'="" S ^TMP("HLA",$J,VAFCCNT)=PV1,VAFCCNT=VAFCCNT+1 ;**707
- S PV2=$$PV2^VAFCSB I PV2'="" S ^TMP("HLA",$J,VAFCCNT)=PV2,VAFCCNT=VAFCCNT+1 ;**707
- S PRES=$$PHARA^VAFCSB I PRES'="" S ^TMP("HLA",$J,VAFCCNT)=PRES,VAFCCNT=VAFCCNT+1 ;**707
- S LABE=$$LABE^VAFCSB I LABE'="" S ^TMP("HLA",$J,VAFCCNT)=LABE,VAFCCNT=VAFCCNT+1 ;**707
- S RADE=$$RADE^VAFCSB I RADE'="" S ^TMP("HLA",$J,VAFCCNT)=RADE,VAFCCNT=VAFCCNT+1 ;**707
- S SIDG=$$SIG^VAFCSB(DFN) I $G(SIDG)'="" S ^TMP("HLA",$J,VAFCCNT)=SIDG,VAFCCNT=VAFCCNT+1 ;**902 MVI_4634 (ckn) - OBX FOR SELF ID GENDER
- S NAMECOMP=$$NAMEOBX^VAFCSB(DFN) I $G(NAMECOMP)'="" S ^TMP("HLA",$J,VAFCCNT)=NAMECOMP,VAFCCNT=VAFCCNT+1 ;**902 MVI_4634 (ckn): OBX for Patient .01 and Name Components
- S OLD=$$OLD(DFN) I $G(OLD)'="" S ^TMP("HLA",$J,VAFCCNT)=OLD,VAFCCNT=VAFCCNT+1 ;**902 MVI_4634 (ckn) - OBX to mark and Older record
- S DODF=$$DODF^VAFCSB(DFN) I $G(DODF)'="" S ^TMP("HLA",$J,VAFCCNT)=DODF,VAFCCNT=VAFCCNT+1 ;**902 MVI_4898 (ckn) : OBX for DOD fields
- ;**926 Story 3230009 (ckn) : OBX for Additional DOD fields
- S DODD=$$DODD^VAFCSB(DFN) I $G(DODD)'="" S ^TMP("HLA",$J,VAFCCNT)=DODD,VAFCCNT=VAFCCNT+1 ;Date of Death Documents
- S DODOPT=$$DODOPT^VAFCSB(DFN) I $G(DODOPT)'="" S ^TMP("HLA",$J,VAFCCNT)=DODOPT,VAFCCNT=VAFCCNT+1 ;Date of Death Option
- S DODNP=$$DODNTPRV^VAFCSB(DFN) I $G(DODNP)'="" S ^TMP("HLA",$J,VAFCCNT)=DODNP,VAFCCNT=VAFCCNT+1 ;Date Of Death Notify Provider
- ;**967 - Story 783361 (ckn) - OBX for Security Level
- S SECLVL=$$SECLOG^VAFCSB(DFN) I $G(SECLVL)'="" S ^TMP("HLA",$J,VAFCCNT)=SECLVL,VAFCCNT=VAFCCNT+1
- D SEXOR^VAFCSB(DFN,.SEXOR) I $O(SEXOR(0)) N CNT S CNT=0 F S CNT=$O(SEXOR(CNT)) Q:'CNT S ^TMP("HLA",$J,VAFCCNT)=SEXOR(CNT),VAFCCNT=VAFCCNT+1 ;**1059, VAMPI-11114 (dri), **1092, VAMPI-18606 (dri)
- D SEXORD^VAFCSB(DFN,.SEXORD) I $O(SEXORD(0)) D S VAFCCNT=VAFCCNT+1 ;**1059, VAMPI-11114 (dri), **1092, VAMPI-18606 (dri)
- .N CNT,LVL
- .S LVL=1,CNT=0 F S CNT=$O(SEXORD(CNT)) Q:'CNT D
- ..I CNT=1 S ^TMP("HLA",$J,VAFCCNT)=SEXORD(CNT)
- ..I CNT>1 S ^TMP("HLA",$J,VAFCCNT,LVL)=SEXORD(CNT),LVL=LVL+1
- D PRON^VAFCSB(DFN,.PRON) I $O(PRON(0)) N CNT S CNT=0 F S CNT=$O(PRON(CNT)) Q:'CNT S ^TMP("HLA",$J,VAFCCNT)=PRON(CNT),VAFCCNT=VAFCCNT+1 ;**1059, VAMPI-11118 (dri), **1092, VAMPI-18606 (dri)
- D PROND^VAFCSB(DFN,.PROND) I $O(PROND(0)) D S VAFCCNT=VAFCCNT+1 ;**1059, VAMPI-11118 (dri), **1092, VAMPI-18606 (dri)
- .N CNT,LVL
- .S LVL=1,CNT=0 F S CNT=$O(PROND(CNT)) Q:'CNT D
- ..I CNT=1 S ^TMP("HLA",$J,VAFCCNT)=PROND(CNT)
- ..I CNT>1 S ^TMP("HLA",$J,VAFCCNT,LVL)=PROND(CNT),LVL=LVL+1
- ;construct ZPD segment
- S SEQ="1,17,21,34" ;**707 Added 1, 21 and 34 to ZPD fields
- S ^TMP("HLA",$J,VAFCCNT)=$$EN1^VAFHLZPD(DFN,SEQ)
- S VAFCCNT=VAFCCNT+1
- ;**902 MVI_4634 (ckn) - Add ZSP and ZEL segments
- S ZSP=$$EN^VAFHLZSP(DFN) I $G(ZSP)'="" S ^TMP("HLA",$J,VAFCCNT)=ZSP,VAFCCNT=VAFCCNT+1 ;ZSP segment
- S ZEL=$$EN^VAFHLZEL(DFN,"1,8,9",1) I $G(ZEL)'="" S ^TMP("HLA",$J,VAFCCNT)=ZEL,VAFCCNT=VAFCCNT+1 ;ZEL segment
- Q
- ;
- MSH ;process MSH segment
- S VAFCFS=HL("FS")
- S HLQ=HL("Q"),HLFS=HL("FS"),HLECH=HL("ECH")
- S VAFCID=HL("MID")
- S COMP=$E(HL("ECH"),1)
- S REP=$E(HL("ECH"),2)
- S SUBCOMP=$E(HL("ECH"),4)
- S SITE=$$LKUP^XUAF4($P($P(HLNODE,HL("FS"),4),COMP))
- Q
- ;
- QRD ;process QRD segment
- N QRD,X,IDS,WSF,ID,QRDAA,QRDNTC
- S VAFCQRD=HLNODE
- S VAFCRCV=$P(VAFCQRD,HL("FS"),5)
- S IDS=$P(VAFCQRD,HL("FS"),9)
- F X=1:1:$L(IDS,REP) S WSF=$P(IDS,REP,X) D
- . ;get id, assigning authority, and name type code
- . S ID=$P(WSF,COMP),QRDAA=$P($P(WSF,COMP,9),SUBCOMP),QRDNTC=$P(WSF,COMP,10)
- . ;check assigning authority(0363) AND name type code(0203)
- . I QRDAA="USVHA" D
- .. I QRDNTC="NI" S ICN=ID ;National unique individual identifier
- .. I QRDNTC="PI" S DFN=ID ;Patient internal identifier
- . I QRDAA="USSSA" D
- .. I QRDNTC="SS" S SSN=ID ;Social Security number
- Q
- ;
- BLDEVN(DFN,SEQ,EVN,HL,EVR,ERR) ;build EVN for TF last treatment date and event reason
- ; At this point only sequence one and two are supported
- ; Variable list
- ; DFN - internal PATIENT (#2) number
- ; SEQ - variable consisting of sequence numbers delimited by commas
- ; that will be used to build the message
- ; EVN (passed by reference) - array location to place EVN segment result, the array can have existing values when passed.
- ; HL - array that contains the necessary HL variables (init^hlsub)
- ; EVR - event reason that triggered this message
- ; ERR - array that is used to return an error
- ;
- D BLDEVN^VAFCQRY2(DFN,SEQ,.EVN,.HL,EVR,.ERR)
- Q
- ;
- BLDPD1(DFN,SEQ,PD1,HL,ERR) ;
- ; At this point only sequence 3 is supported
- ; Variable list
- ; DFN - internal PATIENT (#2) number
- ; SEQ - variable consisting of sequence numbers delimited by commas
- ; that will be used to build the message
- ; PD1 (passed by reference) - array location to place PD1 segment result, the array can have existing values when passed.
- ; HL - array that contains the necessary HL variables (init^hlsub)
- ; ERR - array that is used to return an error
- ;
- D BLDPD1^VAFCQRY2(DFN,SEQ,.PD1,.HL,.ERR)
- Q
- ;
- BLDPID(DFN,CNT,SEQ,PID,HL,ERR) ;build PID from File #2
- ;The required sequences 3 and 5 will be returned and at this point
- ;sequences 1-3,5-8,10-14,16,17,19,22-24 and 29 are supported
- ;
- ; At this point only sequence one and two are supported
- ; Variable list
- ; DFN - internal PATIENT (#2) number
- ; CNT - value to be place in PID seq#1 (SET ID)
- ; SEQ - variable consisting of sequence numbers delimited by commas
- ; that will be used to build the message
- ; PID (passed by reference) - array location to place PID segment
- ; result, the array can have existing values when passed.
- ; HL - array that contains the necessary HL variables (init^hlsub)
- ; ERR - array that is used to return an error
- ;
- ;if this is a mismatch a null or """" should be passed in, so that
- ;the ICN will be removed at the site
- ;
- D BLDPID^VAFCQRY1(DFN,CNT,SEQ,.PID,.HL,.ERR)
- Q
- ;
- OLD(DFN) ; **902 MVI_4634 (ckn) Return OBX segment to flag a record as "old"
- Q $S($D(^XTMP("MPIF OLD RECORDS",DFN))#2:"OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"OLDER RECORD"_HL("FS")_HL("FS")_"Y",1:"")
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCQRY 8300 printed Jan 18, 2025@04:02:55 Page 2
- VAFCQRY ;BIR/DLR-Query for patient demographics ;1/27/23 14:07
- +1 ;;5.3;Registration;**428,575,627,707,863,902,926,967,1059,1092**;Aug 13, 1993;Build 1
- +2 ;
- IN ;process in the patient query
- +1 NEW IEN,HLA,VAFCCNT,ICN,CLAIM,SG,VAFCER,VAFC,DFN,STATE,CITY,SUBCOMP,COMP,REP,LVL,LVL2,VAFC,SSN,SAVEDFN
- +2 SET VAFCCNT=1
- SET VAFCER=1
- +3 FOR VAFC=1:1
- XECUTE HLNEXT
- if HLQUIT'>0
- QUIT
- SET SG=$EXTRACT(HLNODE,1,3)
- if $TEXT(@SG)]""
- DO @SG
- +4 SET SAVEDFN=$GET(DFN)
- +5 DO CHKID^VAFCQRY2(.ICN,.SSN,.DFN)
- +6 IF $GET(DFN)'>0
- Begin DoDot:1
- +7 ;**863 MVI_2352 if merged send back merged record info for update
- +8 IF SAVEDFN
- IF $DATA(^DPT(SAVEDFN,-9))
- Begin DoDot:2
- +9 NEW DFN,ICN
- +10 SET DFN=^DPT(SAVEDFN,-9)
- SET ICN=$$GETICN^MPIF001(+DFN)
- +11 SET VAFCER="-1^New Primary record "_DFN_" at site with ICN "_ICN
- End DoDot:2
- QUIT
- +12 SET VAFCER="-1^Unknown ICN#"_$GET(ICN)_" and SSN#"_$GET(SSN)
- End DoDot:1
- +13 SET ^TMP("HLA",$JOB,VAFCCNT)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS")_$SELECT(+$GET(VAFCER)'>0:$PIECE(VAFCER,"^",2),1:"")
- SET VAFCCNT=VAFCCNT+1
- +14 SET ^TMP("HLA",$JOB,VAFCCNT)=VAFCQRD
- SET VAFCCNT=VAFCCNT+1
- +15 IF $GET(VAFCER)>0
- DO BLDRSP(DFN,.VAFCCNT)
- +16 DO LINK^HLUTIL3(SITE,.VAFC)
- SET IEN=$ORDER(VAFC(0))
- SET HLL("LINKS",1)="^"_VAFC(IEN)
- +17 DO GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA,"",.HL)
- +18 KILL VAFCER,VAFCID,COMP,SITE,VAFCFS,VAFCRCV,VAFCQRD,^TMP("HLA",$JOB)
- +19 QUIT
- +20 ;
- RESP ;Response processing initiated from the MPI.
- +1 QUIT
- +2 ;
- ROUTE ;Routine logic initiated from the MPI.
- +1 QUIT
- +2 ;
- BLDRSP(DFN,VAFCCNT) ;
- +1 NEW EVN,PID,PD1,SEQ,ERR,CNT,X,PV2,RADE,LABE,PRES
- +2 NEW SIDG,ZEL,ZSP,NAMECOMP,OLD,PV1,DODF,DODD,DODOPT,DODNP,DODDISDT,SECLVL,SEXOR,SEXORD,PRON,PROND
- +3 ;construct EVN (for TF Event Type AND Last Treatment Date)
- +4 SET SEQ="1,2"
- DO BLDEVN(DFN,.SEQ,.EVN,.HL,"A19",.ERR)
- SET ^TMP("HLA",$JOB,VAFCCNT)=EVN(1)
- SET VAFCCNT=VAFCCNT+1
- +5 ;construct PID
- +6 SET SEQ="ALL"
- DO BLDPID(DFN,1,.SEQ,.PID,.HL,.ERR)
- SET ^TMP("HLA",$JOB,VAFCCNT)=PID(1)
- SET X=1
- SET CNT=1
- FOR
- SET X=$ORDER(PID(X))
- if 'X
- QUIT
- IF $DATA(PID(X))
- SET ^TMP("HLA",$JOB,VAFCCNT,CNT)=PID(X)
- SET CNT=CNT+1
- +7 SET VAFCCNT=VAFCCNT+1
- +8 ;construct PD1 **707
- +9 ;S SEQ="3" D BLDPD1(DFN,.SEQ,.PD1,.HL,.ERR) S ^TMP("HLA",$J,VAFCCNT)=PD1(1)
- +10 ;**707
- SET PD1=$$PD1^VAFCSB
- IF PD1'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=PD1
- SET VAFCCNT=VAFCCNT+1
- +11 ;**707
- SET PV1=$$PV1^VAFCSB
- IF PV1'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=PV1
- SET VAFCCNT=VAFCCNT+1
- +12 ;**707
- SET PV2=$$PV2^VAFCSB
- IF PV2'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=PV2
- SET VAFCCNT=VAFCCNT+1
- +13 ;**707
- SET PRES=$$PHARA^VAFCSB
- IF PRES'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=PRES
- SET VAFCCNT=VAFCCNT+1
- +14 ;**707
- SET LABE=$$LABE^VAFCSB
- IF LABE'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=LABE
- SET VAFCCNT=VAFCCNT+1
- +15 ;**707
- SET RADE=$$RADE^VAFCSB
- IF RADE'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=RADE
- SET VAFCCNT=VAFCCNT+1
- +16 ;**902 MVI_4634 (ckn) - OBX FOR SELF ID GENDER
- SET SIDG=$$SIG^VAFCSB(DFN)
- IF $GET(SIDG)'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=SIDG
- SET VAFCCNT=VAFCCNT+1
- +17 ;**902 MVI_4634 (ckn): OBX for Patient .01 and Name Components
- SET NAMECOMP=$$NAMEOBX^VAFCSB(DFN)
- IF $GET(NAMECOMP)'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=NAMECOMP
- SET VAFCCNT=VAFCCNT+1
- +18 ;**902 MVI_4634 (ckn) - OBX to mark and Older record
- SET OLD=$$OLD(DFN)
- IF $GET(OLD)'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=OLD
- SET VAFCCNT=VAFCCNT+1
- +19 ;**902 MVI_4898 (ckn) : OBX for DOD fields
- SET DODF=$$DODF^VAFCSB(DFN)
- IF $GET(DODF)'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=DODF
- SET VAFCCNT=VAFCCNT+1
- +20 ;**926 Story 3230009 (ckn) : OBX for Additional DOD fields
- +21 ;Date of Death Documents
- SET DODD=$$DODD^VAFCSB(DFN)
- IF $GET(DODD)'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=DODD
- SET VAFCCNT=VAFCCNT+1
- +22 ;Date of Death Option
- SET DODOPT=$$DODOPT^VAFCSB(DFN)
- IF $GET(DODOPT)'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=DODOPT
- SET VAFCCNT=VAFCCNT+1
- +23 ;Date Of Death Notify Provider
- SET DODNP=$$DODNTPRV^VAFCSB(DFN)
- IF $GET(DODNP)'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=DODNP
- SET VAFCCNT=VAFCCNT+1
- +24 ;**967 - Story 783361 (ckn) - OBX for Security Level
- +25 SET SECLVL=$$SECLOG^VAFCSB(DFN)
- IF $GET(SECLVL)'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=SECLVL
- SET VAFCCNT=VAFCCNT+1
- +26 ;**1059, VAMPI-11114 (dri), **1092, VAMPI-18606 (dri)
- DO SEXOR^VAFCSB(DFN,.SEXOR)
- IF $ORDER(SEXOR(0))
- NEW CNT
- SET CNT=0
- FOR
- SET CNT=$ORDER(SEXOR(CNT))
- if 'CNT
- QUIT
- SET ^TMP("HLA",$JOB,VAFCCNT)=SEXOR(CNT)
- SET VAFCCNT=VAFCCNT+1
- +27 ;**1059, VAMPI-11114 (dri), **1092, VAMPI-18606 (dri)
- DO SEXORD^VAFCSB(DFN,.SEXORD)
- IF $ORDER(SEXORD(0))
- Begin DoDot:1
- +28 NEW CNT,LVL
- +29 SET LVL=1
- SET CNT=0
- FOR
- SET CNT=$ORDER(SEXORD(CNT))
- if 'CNT
- QUIT
- Begin DoDot:2
- +30 IF CNT=1
- SET ^TMP("HLA",$JOB,VAFCCNT)=SEXORD(CNT)
- +31 IF CNT>1
- SET ^TMP("HLA",$JOB,VAFCCNT,LVL)=SEXORD(CNT)
- SET LVL=LVL+1
- End DoDot:2
- End DoDot:1
- SET VAFCCNT=VAFCCNT+1
- +32 ;**1059, VAMPI-11118 (dri), **1092, VAMPI-18606 (dri)
- DO PRON^VAFCSB(DFN,.PRON)
- IF $ORDER(PRON(0))
- NEW CNT
- SET CNT=0
- FOR
- SET CNT=$ORDER(PRON(CNT))
- if 'CNT
- QUIT
- SET ^TMP("HLA",$JOB,VAFCCNT)=PRON(CNT)
- SET VAFCCNT=VAFCCNT+1
- +33 ;**1059, VAMPI-11118 (dri), **1092, VAMPI-18606 (dri)
- DO PROND^VAFCSB(DFN,.PROND)
- IF $ORDER(PROND(0))
- Begin DoDot:1
- +34 NEW CNT,LVL
- +35 SET LVL=1
- SET CNT=0
- FOR
- SET CNT=$ORDER(PROND(CNT))
- if 'CNT
- QUIT
- Begin DoDot:2
- +36 IF CNT=1
- SET ^TMP("HLA",$JOB,VAFCCNT)=PROND(CNT)
- +37 IF CNT>1
- SET ^TMP("HLA",$JOB,VAFCCNT,LVL)=PROND(CNT)
- SET LVL=LVL+1
- End DoDot:2
- End DoDot:1
- SET VAFCCNT=VAFCCNT+1
- +38 ;construct ZPD segment
- +39 ;**707 Added 1, 21 and 34 to ZPD fields
- SET SEQ="1,17,21,34"
- +40 SET ^TMP("HLA",$JOB,VAFCCNT)=$$EN1^VAFHLZPD(DFN,SEQ)
- +41 SET VAFCCNT=VAFCCNT+1
- +42 ;**902 MVI_4634 (ckn) - Add ZSP and ZEL segments
- +43 ;ZSP segment
- SET ZSP=$$EN^VAFHLZSP(DFN)
- IF $GET(ZSP)'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=ZSP
- SET VAFCCNT=VAFCCNT+1
- +44 ;ZEL segment
- SET ZEL=$$EN^VAFHLZEL(DFN,"1,8,9",1)
- IF $GET(ZEL)'=""
- SET ^TMP("HLA",$JOB,VAFCCNT)=ZEL
- SET VAFCCNT=VAFCCNT+1
- +45 QUIT
- +46 ;
- MSH ;process MSH segment
- +1 SET VAFCFS=HL("FS")
- +2 SET HLQ=HL("Q")
- SET HLFS=HL("FS")
- SET HLECH=HL("ECH")
- +3 SET VAFCID=HL("MID")
- +4 SET COMP=$EXTRACT(HL("ECH"),1)
- +5 SET REP=$EXTRACT(HL("ECH"),2)
- +6 SET SUBCOMP=$EXTRACT(HL("ECH"),4)
- +7 SET SITE=$$LKUP^XUAF4($PIECE($PIECE(HLNODE,HL("FS"),4),COMP))
- +8 QUIT
- +9 ;
- QRD ;process QRD segment
- +1 NEW QRD,X,IDS,WSF,ID,QRDAA,QRDNTC
- +2 SET VAFCQRD=HLNODE
- +3 SET VAFCRCV=$PIECE(VAFCQRD,HL("FS"),5)
- +4 SET IDS=$PIECE(VAFCQRD,HL("FS"),9)
- +5 FOR X=1:1:$LENGTH(IDS,REP)
- SET WSF=$PIECE(IDS,REP,X)
- Begin DoDot:1
- +6 ;get id, assigning authority, and name type code
- +7 SET ID=$PIECE(WSF,COMP)
- SET QRDAA=$PIECE($PIECE(WSF,COMP,9),SUBCOMP)
- SET QRDNTC=$PIECE(WSF,COMP,10)
- +8 ;check assigning authority(0363) AND name type code(0203)
- +9 IF QRDAA="USVHA"
- Begin DoDot:2
- +10 ;National unique individual identifier
- IF QRDNTC="NI"
- SET ICN=ID
- +11 ;Patient internal identifier
- IF QRDNTC="PI"
- SET DFN=ID
- End DoDot:2
- +12 IF QRDAA="USSSA"
- Begin DoDot:2
- +13 ;Social Security number
- IF QRDNTC="SS"
- SET SSN=ID
- End DoDot:2
- End DoDot:1
- +14 QUIT
- +15 ;
- BLDEVN(DFN,SEQ,EVN,HL,EVR,ERR) ;build EVN for TF last treatment date and event reason
- +1 ; At this point only sequence one and two are supported
- +2 ; Variable list
- +3 ; DFN - internal PATIENT (#2) number
- +4 ; SEQ - variable consisting of sequence numbers delimited by commas
- +5 ; that will be used to build the message
- +6 ; EVN (passed by reference) - array location to place EVN segment result, the array can have existing values when passed.
- +7 ; HL - array that contains the necessary HL variables (init^hlsub)
- +8 ; EVR - event reason that triggered this message
- +9 ; ERR - array that is used to return an error
- +10 ;
- +11 DO BLDEVN^VAFCQRY2(DFN,SEQ,.EVN,.HL,EVR,.ERR)
- +12 QUIT
- +13 ;
- BLDPD1(DFN,SEQ,PD1,HL,ERR) ;
- +1 ; At this point only sequence 3 is supported
- +2 ; Variable list
- +3 ; DFN - internal PATIENT (#2) number
- +4 ; SEQ - variable consisting of sequence numbers delimited by commas
- +5 ; that will be used to build the message
- +6 ; PD1 (passed by reference) - array location to place PD1 segment result, the array can have existing values when passed.
- +7 ; HL - array that contains the necessary HL variables (init^hlsub)
- +8 ; ERR - array that is used to return an error
- +9 ;
- +10 DO BLDPD1^VAFCQRY2(DFN,SEQ,.PD1,.HL,.ERR)
- +11 QUIT
- +12 ;
- BLDPID(DFN,CNT,SEQ,PID,HL,ERR) ;build PID from File #2
- +1 ;The required sequences 3 and 5 will be returned and at this point
- +2 ;sequences 1-3,5-8,10-14,16,17,19,22-24 and 29 are supported
- +3 ;
- +4 ; At this point only sequence one and two are supported
- +5 ; Variable list
- +6 ; DFN - internal PATIENT (#2) number
- +7 ; CNT - value to be place in PID seq#1 (SET ID)
- +8 ; SEQ - variable consisting of sequence numbers delimited by commas
- +9 ; that will be used to build the message
- +10 ; PID (passed by reference) - array location to place PID segment
- +11 ; result, the array can have existing values when passed.
- +12 ; HL - array that contains the necessary HL variables (init^hlsub)
- +13 ; ERR - array that is used to return an error
- +14 ;
- +15 ;if this is a mismatch a null or """" should be passed in, so that
- +16 ;the ICN will be removed at the site
- +17 ;
- +18 DO BLDPID^VAFCQRY1(DFN,CNT,SEQ,.PID,.HL,.ERR)
- +19 QUIT
- +20 ;
- OLD(DFN) ; **902 MVI_4634 (ckn) Return OBX segment to flag a record as "old"
- +1 QUIT $SELECT($DATA(^XTMP("MPIF OLD RECORDS",DFN))#2:"OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"OLDER RECORD"_HL("FS")_HL("FS")_"Y",1:"")
- +2 ;