source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCQRY.m@ 1499

Last change on this file since 1499 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1VAFCQRY ;BIR/DLR-Query for patient demographics ;10/18/2000
2 ;;5.3;Registration;**428,575,627,707**;Aug 13, 1993;Build 14
3 ;
4IN ;process in the patient query
5 N IEN,HLA,VAFCCNT,ICN,CLAIM,SG,VAFCER,VAFC,DFN,STATE,CITY,SUBCOMP,COMP,REP,LVL,LVL2,VAFC,SSN
6 S VAFCCNT=1,VAFCER=1
7 F VAFC=1:1 X HLNEXT Q:HLQUIT'>0 S SG=$E(HLNODE,1,3) D:$T(@SG)]"" @SG
8 D CHKID^VAFCQRY2(.ICN,.SSN,.DFN)
9 I $G(DFN)'>0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_" and SSN#"_$G(SSN)
10 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
11 S ^TMP("HLA",$J,VAFCCNT)=VAFCQRD,VAFCCNT=VAFCCNT+1
12 I $G(VAFCER)>0 D BLDRSP(DFN,.VAFCCNT)
13 D LINK^HLUTIL3(SITE,.VAFC) S IEN=$O(VAFC(0)) S HLL("LINKS",1)="^"_VAFC(IEN)
14 D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA,"",.HL)
15 K VAFCER,VAFCID,COMP,SITE,VAFCFS,VAFCRCV,VAFCQRD,^TMP("HLA",$J)
16 Q
17RESP ;Response processing initiated from the MPI.
18 Q
19ROUTE ;Routine logic initiated from the MPI.
20 Q
21BLDRSP(DFN,VAFCCNT) ;
22 N EVN,PID,PD1,SEQ,ERR,CNT,X,PV2,RADE,LABE,PRES
23 ;construct EVN (for TF Event Type AND Last Treatment Date)
24 S SEQ="1,2" D BLDEVN(DFN,.SEQ,.EVN,.HL,"A19",.ERR) S ^TMP("HLA",$J,VAFCCNT)=EVN(1) S VAFCCNT=VAFCCNT+1
25 ;construct PID
26 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
27 S VAFCCNT=VAFCCNT+1
28 ;construct PD1 **707
29 ;S SEQ="3" D BLDPD1(DFN,.SEQ,.PD1,.HL,.ERR) S ^TMP("HLA",$J,VAFCCNT)=PD1(1)
30 S PD1=$$PD1^VAFCSB I PD1'="" S ^TMP("HLA",$J,VAFCCNT)=PD1,VAFCCNT=VAFCCNT+1 ;**707
31 S PV1=$$PV1^VAFCSB I PV1'="" S ^TMP("HLA",$J,VAFCCNT)=PV1,VAFCCNT=VAFCCNT+1 ;**707
32 S PV2=$$PV2^VAFCSB I PV2'="" S ^TMP("HLA",$J,VAFCCNT)=PV2,VAFCCNT=VAFCCNT+1 ;**707
33 S PRES=$$PHARA^VAFCSB I PRES'="" S ^TMP("HLA",$J,VAFCCNT)=PRES,VAFCCNT=VAFCCNT+1 ;**707
34 S LABE=$$LABE^VAFCSB I LABE'="" S ^TMP("HLA",$J,VAFCCNT)=LABE,VAFCCNT=VAFCCNT+1 ;**707
35 S RADE=$$RADE^VAFCSB I RADE'="" S ^TMP("HLA",$J,VAFCCNT)=RADE,VAFCCNT=VAFCCNT+1 ;**707
36 ;** PATCH 575
37 ;construct ZPD segment
38 S SEQ="1,17,21,34" ;**707 Added 1, 21 and 34 to ZPD fields
39 S ^TMP("HLA",$J,VAFCCNT)=$$EN1^VAFHLZPD(DFN,SEQ)
40 S VAFCCNT=VAFCCNT+1
41 Q
42MSH ;process MSH segment
43 S VAFCFS=HL("FS")
44 S HLQ=HL("Q"),HLFS=HL("FS"),HLECH=HL("ECH")
45 S VAFCID=HL("MID")
46 S COMP=$E(HL("ECH"),1)
47 S REP=$E(HL("ECH"),2)
48 S SUBCOMP=$E(HL("ECH"),4)
49 S SITE=$$LKUP^XUAF4($P($P(HLNODE,HL("FS"),4),COMP))
50 Q
51QRD ;process QRD segment
52 N QRD,X,IDS,WSF,ID,QRDAA,QRDNTC
53 S VAFCQRD=HLNODE
54 S VAFCRCV=$P(VAFCQRD,HL("FS"),5)
55 S IDS=$P(VAFCQRD,HL("FS"),9)
56 F X=1:1:$L(IDS,REP) S WSF=$P(IDS,REP,X) D
57 . ;get id, assigning authority, and name type code
58 . S ID=$P(WSF,COMP),QRDAA=$P($P(WSF,COMP,9),SUBCOMP),QRDNTC=$P(WSF,COMP,10)
59 . ;check assigning authority(0363) AND name type code(0203)
60 . I QRDAA="USVHA" D
61 .. I QRDNTC="NI" S ICN=ID ;National unique individual identifier
62 .. I QRDNTC="PI" S DFN=ID ;Patient internal identifier
63 . I QRDAA="USSSA" D
64 .. I QRDNTC="SS" S SSN=ID ;Social Security number
65 Q
66BLDEVN(DFN,SEQ,EVN,HL,EVR,ERR) ;build EVN for TF last treatment date and event reason
67 ; At this point only sequence one and two are supported
68 ; Variable list
69 ; DFN - internal PATIENT (#2) number
70 ; SEQ - variable consisting of sequence numbers delimited by commas
71 ; that will be used to build the message
72 ; EVN (passed by reference) - array location to place EVN segment result, the array can have existing values when passed.
73 ; HL - array that contains the necessary HL variables (init^hlsub)
74 ; EVR - event reason that triggered this message
75 ; ERR - array that is used to return an error
76 ;
77 D BLDEVN^VAFCQRY2(DFN,SEQ,.EVN,.HL,EVR,.ERR)
78 Q
79BLDPD1(DFN,SEQ,PD1,HL,ERR) ;
80 ; At this point only sequence 3 is supported
81 ; Variable list
82 ; DFN - internal PATIENT (#2) number
83 ; SEQ - variable consisting of sequence numbers delimited by commas
84 ; that will be used to build the message
85 ; PD1 (passed by reference) - array location to place PD1 segment result, the array can have existing values when passed.
86 ; HL - array that contains the necessary HL variables (init^hlsub)
87 ; ERR - array that is used to return an error
88 ;
89 D BLDPD1^VAFCQRY2(DFN,SEQ,.PD1,.HL,.ERR)
90 Q
91BLDPID(DFN,CNT,SEQ,PID,HL,ERR) ;build PID from File #2
92 ;The required sequences 3 and 5 will be returned and at this point
93 ;sequences 1-3,5-8,10-14,16,17,19,22-24 and 29 are supported
94 ;
95 ; At this point only sequence one and two are supported
96 ; Variable list
97 ; DFN - internal PATIENT (#2) number
98 ; CNT - value to be place in PID seq#1 (SET ID)
99 ; SEQ - variable consisting of sequence numbers delimited by commas
100 ; that will be used to build the message
101 ; PID (passed by reference) - array location to place PID segment
102 ; result, the array can have existing values when passed.
103 ; HL - array that contains the necessary HL variables (init^hlsub)
104 ; ERR - array that is used to return an error
105 ;
106 ;if this is a mismatch a null or """" should be passed in, so that
107 ;the ICN will be removed at the site
108 ;
109 D BLDPID^VAFCQRY1(DFN,CNT,SEQ,.PID,.HL,.ERR)
110 Q
Note: See TracBrowser for help on using the repository browser.