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

VAFCQRY.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. IN ;process in the patient query
  1. N IEN,HLA,VAFCCNT,ICN,CLAIM,SG,VAFCER,VAFC,DFN,STATE,CITY,SUBCOMP,COMP,REP,LVL,LVL2,VAFC,SSN,SAVEDFN
  1. S VAFCCNT=1,VAFCER=1
  1. F VAFC=1:1 X HLNEXT Q:HLQUIT'>0 S SG=$E(HLNODE,1,3) D:$T(@SG)]"" @SG
  1. S SAVEDFN=$G(DFN)
  1. D CHKID^VAFCQRY2(.ICN,.SSN,.DFN)
  1. I $G(DFN)'>0 D
  1. . ;**863 MVI_2352 if merged send back merged record info for update
  1. . I SAVEDFN,$D(^DPT(SAVEDFN,-9)) D Q
  1. .. N DFN,ICN
  1. .. S DFN=^DPT(SAVEDFN,-9),ICN=$$GETICN^MPIF001(+DFN)
  1. .. S VAFCER="-1^New Primary record "_DFN_" at site with ICN "_ICN
  1. . S VAFCER="-1^Unknown ICN#"_$G(ICN)_" and SSN#"_$G(SSN)
  1. 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
  1. S ^TMP("HLA",$J,VAFCCNT)=VAFCQRD,VAFCCNT=VAFCCNT+1
  1. I $G(VAFCER)>0 D BLDRSP(DFN,.VAFCCNT)
  1. D LINK^HLUTIL3(SITE,.VAFC) S IEN=$O(VAFC(0)) S HLL("LINKS",1)="^"_VAFC(IEN)
  1. D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA,"",.HL)
  1. K VAFCER,VAFCID,COMP,SITE,VAFCFS,VAFCRCV,VAFCQRD,^TMP("HLA",$J)
  1. Q
  1. ;
  1. RESP ;Response processing initiated from the MPI.
  1. Q
  1. ;
  1. ROUTE ;Routine logic initiated from the MPI.
  1. Q
  1. ;
  1. BLDRSP(DFN,VAFCCNT) ;
  1. N EVN,PID,PD1,SEQ,ERR,CNT,X,PV2,RADE,LABE,PRES
  1. N SIDG,ZEL,ZSP,NAMECOMP,OLD,PV1,DODF,DODD,DODOPT,DODNP,DODDISDT,SECLVL,SEXOR,SEXORD,PRON,PROND
  1. ;construct EVN (for TF Event Type AND Last Treatment Date)
  1. S SEQ="1,2" D BLDEVN(DFN,.SEQ,.EVN,.HL,"A19",.ERR) S ^TMP("HLA",$J,VAFCCNT)=EVN(1) S VAFCCNT=VAFCCNT+1
  1. ;construct PID
  1. 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
  1. S VAFCCNT=VAFCCNT+1
  1. ;construct PD1 **707
  1. ;S SEQ="3" D BLDPD1(DFN,.SEQ,.PD1,.HL,.ERR) S ^TMP("HLA",$J,VAFCCNT)=PD1(1)
  1. S PD1=$$PD1^VAFCSB I PD1'="" S ^TMP("HLA",$J,VAFCCNT)=PD1,VAFCCNT=VAFCCNT+1 ;**707
  1. S PV1=$$PV1^VAFCSB I PV1'="" S ^TMP("HLA",$J,VAFCCNT)=PV1,VAFCCNT=VAFCCNT+1 ;**707
  1. S PV2=$$PV2^VAFCSB I PV2'="" S ^TMP("HLA",$J,VAFCCNT)=PV2,VAFCCNT=VAFCCNT+1 ;**707
  1. S PRES=$$PHARA^VAFCSB I PRES'="" S ^TMP("HLA",$J,VAFCCNT)=PRES,VAFCCNT=VAFCCNT+1 ;**707
  1. S LABE=$$LABE^VAFCSB I LABE'="" S ^TMP("HLA",$J,VAFCCNT)=LABE,VAFCCNT=VAFCCNT+1 ;**707
  1. S RADE=$$RADE^VAFCSB I RADE'="" S ^TMP("HLA",$J,VAFCCNT)=RADE,VAFCCNT=VAFCCNT+1 ;**707
  1. 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
  1. 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
  1. 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
  1. 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
  1. ;**926 Story 3230009 (ckn) : OBX for Additional DOD fields
  1. S DODD=$$DODD^VAFCSB(DFN) I $G(DODD)'="" S ^TMP("HLA",$J,VAFCCNT)=DODD,VAFCCNT=VAFCCNT+1 ;Date of Death Documents
  1. S DODOPT=$$DODOPT^VAFCSB(DFN) I $G(DODOPT)'="" S ^TMP("HLA",$J,VAFCCNT)=DODOPT,VAFCCNT=VAFCCNT+1 ;Date of Death Option
  1. S DODNP=$$DODNTPRV^VAFCSB(DFN) I $G(DODNP)'="" S ^TMP("HLA",$J,VAFCCNT)=DODNP,VAFCCNT=VAFCCNT+1 ;Date Of Death Notify Provider
  1. ;**967 - Story 783361 (ckn) - OBX for Security Level
  1. S SECLVL=$$SECLOG^VAFCSB(DFN) I $G(SECLVL)'="" S ^TMP("HLA",$J,VAFCCNT)=SECLVL,VAFCCNT=VAFCCNT+1
  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)
  1. D SEXORD^VAFCSB(DFN,.SEXORD) I $O(SEXORD(0)) D S VAFCCNT=VAFCCNT+1 ;**1059, VAMPI-11114 (dri), **1092, VAMPI-18606 (dri)
  1. .N CNT,LVL
  1. .S LVL=1,CNT=0 F S CNT=$O(SEXORD(CNT)) Q:'CNT D
  1. ..I CNT=1 S ^TMP("HLA",$J,VAFCCNT)=SEXORD(CNT)
  1. ..I CNT>1 S ^TMP("HLA",$J,VAFCCNT,LVL)=SEXORD(CNT),LVL=LVL+1
  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)
  1. D PROND^VAFCSB(DFN,.PROND) I $O(PROND(0)) D S VAFCCNT=VAFCCNT+1 ;**1059, VAMPI-11118 (dri), **1092, VAMPI-18606 (dri)
  1. .N CNT,LVL
  1. .S LVL=1,CNT=0 F S CNT=$O(PROND(CNT)) Q:'CNT D
  1. ..I CNT=1 S ^TMP("HLA",$J,VAFCCNT)=PROND(CNT)
  1. ..I CNT>1 S ^TMP("HLA",$J,VAFCCNT,LVL)=PROND(CNT),LVL=LVL+1
  1. ;construct ZPD segment
  1. S SEQ="1,17,21,34" ;**707 Added 1, 21 and 34 to ZPD fields
  1. S ^TMP("HLA",$J,VAFCCNT)=$$EN1^VAFHLZPD(DFN,SEQ)
  1. S VAFCCNT=VAFCCNT+1
  1. ;**902 MVI_4634 (ckn) - Add ZSP and ZEL segments
  1. S ZSP=$$EN^VAFHLZSP(DFN) I $G(ZSP)'="" S ^TMP("HLA",$J,VAFCCNT)=ZSP,VAFCCNT=VAFCCNT+1 ;ZSP segment
  1. S ZEL=$$EN^VAFHLZEL(DFN,"1,8,9",1) I $G(ZEL)'="" S ^TMP("HLA",$J,VAFCCNT)=ZEL,VAFCCNT=VAFCCNT+1 ;ZEL segment
  1. Q
  1. ;
  1. MSH ;process MSH segment
  1. S VAFCFS=HL("FS")
  1. S HLQ=HL("Q"),HLFS=HL("FS"),HLECH=HL("ECH")
  1. S VAFCID=HL("MID")
  1. S COMP=$E(HL("ECH"),1)
  1. S REP=$E(HL("ECH"),2)
  1. S SUBCOMP=$E(HL("ECH"),4)
  1. S SITE=$$LKUP^XUAF4($P($P(HLNODE,HL("FS"),4),COMP))
  1. Q
  1. ;
  1. QRD ;process QRD segment
  1. N QRD,X,IDS,WSF,ID,QRDAA,QRDNTC
  1. S VAFCQRD=HLNODE
  1. S VAFCRCV=$P(VAFCQRD,HL("FS"),5)
  1. S IDS=$P(VAFCQRD,HL("FS"),9)
  1. F X=1:1:$L(IDS,REP) S WSF=$P(IDS,REP,X) D
  1. . ;get id, assigning authority, and name type code
  1. . S ID=$P(WSF,COMP),QRDAA=$P($P(WSF,COMP,9),SUBCOMP),QRDNTC=$P(WSF,COMP,10)
  1. . ;check assigning authority(0363) AND name type code(0203)
  1. . I QRDAA="USVHA" D
  1. .. I QRDNTC="NI" S ICN=ID ;National unique individual identifier
  1. .. I QRDNTC="PI" S DFN=ID ;Patient internal identifier
  1. . I QRDAA="USSSA" D
  1. .. I QRDNTC="SS" S SSN=ID ;Social Security number
  1. Q
  1. ;
  1. 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
  1. ; Variable list
  1. ; DFN - internal PATIENT (#2) number
  1. ; SEQ - variable consisting of sequence numbers delimited by commas
  1. ; that will be used to build the message
  1. ; EVN (passed by reference) - array location to place EVN segment result, the array can have existing values when passed.
  1. ; HL - array that contains the necessary HL variables (init^hlsub)
  1. ; EVR - event reason that triggered this message
  1. ; ERR - array that is used to return an error
  1. ;
  1. D BLDEVN^VAFCQRY2(DFN,SEQ,.EVN,.HL,EVR,.ERR)
  1. Q
  1. ;
  1. BLDPD1(DFN,SEQ,PD1,HL,ERR) ;
  1. ; At this point only sequence 3 is supported
  1. ; Variable list
  1. ; DFN - internal PATIENT (#2) number
  1. ; SEQ - variable consisting of sequence numbers delimited by commas
  1. ; that will be used to build the message
  1. ; PD1 (passed by reference) - array location to place PD1 segment result, the array can have existing values when passed.
  1. ; HL - array that contains the necessary HL variables (init^hlsub)
  1. ; ERR - array that is used to return an error
  1. ;
  1. D BLDPD1^VAFCQRY2(DFN,SEQ,.PD1,.HL,.ERR)
  1. Q
  1. ;
  1. 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
  1. ;sequences 1-3,5-8,10-14,16,17,19,22-24 and 29 are supported
  1. ;
  1. ; At this point only sequence one and two are supported
  1. ; Variable list
  1. ; DFN - internal PATIENT (#2) number
  1. ; CNT - value to be place in PID seq#1 (SET ID)
  1. ; SEQ - variable consisting of sequence numbers delimited by commas
  1. ; that will be used to build the message
  1. ; PID (passed by reference) - array location to place PID segment
  1. ; result, the array can have existing values when passed.
  1. ; HL - array that contains the necessary HL variables (init^hlsub)
  1. ; ERR - array that is used to return an error
  1. ;
  1. ;if this is a mismatch a null or """" should be passed in, so that
  1. ;the ICN will be removed at the site
  1. ;
  1. D BLDPID^VAFCQRY1(DFN,CNT,SEQ,.PID,.HL,.ERR)
  1. Q
  1. ;
  1. OLD(DFN) ; **902 MVI_4634 (ckn) Return OBX segment to flag a record as "old"
  1. 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:"")
  1. ;