1 | MAGGTPT1 ;WOIFO/GEK - Delphi-Broker calls for patient lookup and information ; [ 06/20/2001 08:57 ]
|
---|
2 | ;;3.0;IMAGING;**16,8,92,46,59**;Nov 27, 2007;Build 20
|
---|
3 | ;; Per VHA Directive 2004-038, this routine should not be modified.
|
---|
4 | ;; +---------------------------------------------------------------+
|
---|
5 | ;; | Property of the US Government. |
|
---|
6 | ;; | No permission to copy or redistribute this software is given. |
|
---|
7 | ;; | Use of unreleased versions of this software requires the user |
|
---|
8 | ;; | to execute a written test agreement with the VistA Imaging |
|
---|
9 | ;; | Development Office of the Department of Veterans Affairs, |
|
---|
10 | ;; | telephone (301) 734-0100. |
|
---|
11 | ;; | |
|
---|
12 | ;; | The Food and Drug Administration classifies this software as |
|
---|
13 | ;; | a medical device. As such, it may not be changed in any way. |
|
---|
14 | ;; | Modifications to this software may result in an adulterated |
|
---|
15 | ;; | medical device under 21CFR820, the use of which is considered |
|
---|
16 | ;; | to be a violation of US Federal Statutes. |
|
---|
17 | ;; +---------------------------------------------------------------+
|
---|
18 | ;;
|
---|
19 | Q
|
---|
20 | ;
|
---|
21 | FIND(MAGRY,ZY) ;RPC [MAGG PAT FIND]
|
---|
22 | ; Call to Do a lookup using FIND^DIC
|
---|
23 | ; MAGRY is the Array to return.
|
---|
24 | ; ZY is parameter sent by calling app (Delphi)
|
---|
25 | ; FILE NUM ^ NUM TO RETURN ^ TEXT TO MATCH ^ ^ SCREEN ($P 5-99)
|
---|
26 | N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
|
---|
27 | ;
|
---|
28 | N X,Y,I,Z,MAGDFN,WARD
|
---|
29 | N FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT
|
---|
30 | S (FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT)=""
|
---|
31 | ;
|
---|
32 | S FILE=2 ; Patient File
|
---|
33 | ; Number of entries to return, If 0 we'll stop at 100
|
---|
34 | S NUM=$S(+$P(ZY,U,1):+$P(ZY,U,1),1:100)
|
---|
35 | S VAL=$P(ZY,U,2) ; this is the starting value i.e. 'Smi'
|
---|
36 | S SCR=$P(ZY,U,5,99)
|
---|
37 | S FLDS=$P(ZY,U,3)
|
---|
38 | ; $P(ZU,U,4) isn't used.
|
---|
39 | ; If specific fields aren't requested,
|
---|
40 | ; Get Identifiers, and ward as FLDS
|
---|
41 | ;I '$L(FLDS) S FLDS=FLDS_";.1;.03;.09;.301;391"
|
---|
42 | I '$L(FLDS) S FLDS=FLDS_";.1;.301;391"
|
---|
43 | ; we'll add ACN to the index to search, for ward
|
---|
44 | ; for speed we'll decide which xref to use
|
---|
45 | S INDEX=$S(VAL?9N:"SSN^ACN",VAL?1U1.N:"BS5^ACN",1:"B^ACN")
|
---|
46 | ;
|
---|
47 | K ^TMP("DILIST",$J)
|
---|
48 | K ^TMP("DIERR",$J)
|
---|
49 | ; VAL is the initial value to search for. i.e. the user input.
|
---|
50 | ; Next line is to stop the FM Infinite Error Trap problem.
|
---|
51 | I $L(VAL)>30 S MAGRY(0)="0^Invalid: Input '"_$E(VAL,1,40)_"...' is too long. "_$L(VAL)_" characters." Q
|
---|
52 | D FIND^DIC(FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT)
|
---|
53 | ;
|
---|
54 | ; if no Match or ERROR we return 0 as 1st '^' piece.
|
---|
55 | ;
|
---|
56 | I '$D(^TMP("DILIST",$J,1)) S I=1 D Q
|
---|
57 | . I $D(^TMP("DIERR",$J)) D FINDERR(I) Q
|
---|
58 | . S MAGRY(I)="NO MATCH for lookup on """_$P(ZY,"^",2)_""""
|
---|
59 | ;
|
---|
60 | ; so we have some matches, (BUT we could still have an error)
|
---|
61 | ; so first list all matches, then the Errors, if any.
|
---|
62 | S I="" F S I=$O(^TMP("DILIST",$J,1,I)) Q:I="" D
|
---|
63 | . S X=^TMP("DILIST",$J,1,I) ; Name
|
---|
64 | . S MAGDFN=^TMP("DILIST",$J,2,I) ; DFN
|
---|
65 | . ;
|
---|
66 | . S WARD=^TMP("DILIST",$J,"ID",I,.1)
|
---|
67 | . K ^TMP("DILIST",$J,"ID",I,.1)
|
---|
68 | . I $E(WARD,1,$L(VAL))=VAL S X=WARD_" "_X
|
---|
69 | . ;
|
---|
70 | . S X=X_" "_$$DOB^DPTLK1(MAGDFN)_" "_$$SSN^DPTLK1(MAGDFN)
|
---|
71 | . S Z=0
|
---|
72 | . ; We are displaying other identifiers with each patient.
|
---|
73 | . F S Z=$O(^TMP("DILIST",$J,"ID",I,Z)) Q:Z="" S X=X_" "_^(Z)
|
---|
74 | . S MAGRY(I)=X_"^"_+MAGDFN
|
---|
75 | ;
|
---|
76 | I $D(^TMP("DIERR",$J)) D FINDERR() Q
|
---|
77 | I '$D(^TMP("DILIST",$J,0)) Q
|
---|
78 | S X=^TMP("DILIST",$J,0)
|
---|
79 | S I=$O(MAGRY(""),-1)+1
|
---|
80 | S MAGRY(0)="Found "_$P(X,"^")_" entr"_$S((+X=1):"y",1:"ies")_" matching """_$P(ZY,"^",3)_""""
|
---|
81 | I $P(X,"^",3)>0 S MAGRY(0)=MAGRY(0)_" there are more"
|
---|
82 | Q
|
---|
83 | FINDERR(XI) ;
|
---|
84 | I '+$G(XI) S XI=$O(MAGRY(""),-1)+1
|
---|
85 | S MAGRY(XI)="ERROR^"_^TMP("DIERR",$J,1,"TEXT",1)
|
---|
86 | Q
|
---|
87 | INFO(MAGRY,DATA) ;RPC [MAGG PAT INFO] Call to Return patient info.
|
---|
88 | ; Input parameters
|
---|
89 | ; DATA: MAGDFN ^ NOLOG ^ ISICN
|
---|
90 | ; MAGDFN -- Patient DFN
|
---|
91 | ; NOLOG -- 0/1; if 1, then do NOT update the Session log
|
---|
92 | ; ISICN -- 0/1 if 1, then this is an ICN, if 0 (default) this is a DFN ; Patch 41
|
---|
93 | ; MAGRY is a string, we return the following :
|
---|
94 | ; //$P 1 2 3 4 5 6 7 8 9 10
|
---|
95 | ; // status ^ DFN ^ name ^ sex ^ DOB ^ SSN ^ S/C ^ TYPE ^ Veteran(y/n) ^ Patient Image Count
|
---|
96 | ; //$P 11 12 13
|
---|
97 | ; ICN SITE Number ^ Production Account 1/0
|
---|
98 | ; VADM(1)=Patient's name
|
---|
99 | ; VADM(5)=Patient's sex (M^MALE)
|
---|
100 | ; VADM(3)=Patient's DOB (internal^external)
|
---|
101 | ; VADM(2)=Patient's SSN (internal^external)
|
---|
102 | ; VAEL(3)=Patient's Service Connected? (#.301) (1=yes)
|
---|
103 | ; VAEL(4)=Patient's Veteran Y/N (#1901) (1=yes)
|
---|
104 | ; VAEL(6)=Patient's Type (#391) (internal^external)
|
---|
105 | ;
|
---|
106 | N MAGDFN,DFN,X,NOLOG,VADM,VAEL,VAERR,ISICN
|
---|
107 | S MAGDFN=$P(DATA,U),NOLOG=+$P(DATA,U,2),ISICN=+$P(DATA,U,3)
|
---|
108 | I ISICN D GETDFN^VAFCTFU1(.DFN,MAGDFN)
|
---|
109 | E S DFN=+MAGDFN
|
---|
110 | D DEM^VADPT,ELIG^VADPT
|
---|
111 | I VAERR S MAGRY="0^"_"Entry not found in Patient file." Q
|
---|
112 | S X=$TR($$FMTE^XLFDT($P(VADM(3),"^"),"2FD")," ",0)
|
---|
113 | ; // status ^ DFN ^ name ^ sex ^ DOB ^ SSN ^ S/C ^ TYPE ^ Veteran(y/n) ^ Patient Image Count
|
---|
114 | S $P(MAGRY,"^",1,2)="1^"_DFN
|
---|
115 | ; Fields: NAME, SEX, DATE OF BIRTH, SSN
|
---|
116 | S $P(MAGRY,"^",3,6)=$G(VADM(1))_"^"_$P(VADM(5),"^",2)_"^"_X_"^"_$P(VADM(2),"^")
|
---|
117 | ; Fields: Service Connected?, Type, Veteran Y/N?
|
---|
118 | S $P(MAGRY,"^",7,9)=$S(+VAEL(3):"YES",1:"")_"^"_$P(VAEL(6),"^",2)_"^"_$S(+VAEL(4):"YES",1:"")
|
---|
119 | ; Fields: Patient Image Count
|
---|
120 | S $P(MAGRY,"^",10)=$$IMGCT(DFN)_"^"
|
---|
121 | ; Additions. for Patch 41
|
---|
122 | ; Fields : Patient ICN
|
---|
123 | S $P(MAGRY,"^",11)=$$GETICN^MPIF001(DFN)
|
---|
124 | S X=$$SITE^VASITE
|
---|
125 | ; Fields: Site Number Prod Acct
|
---|
126 | S $P(MAGRY,"^",12)=$P($G(X),"^",3)_"^"_"1" ; We'll default to Production Account = Yes.
|
---|
127 | ; NEED KERNEL PATCH XU*8.0*284 FOR PROD^XUPROD
|
---|
128 | ; Fields : the Actual value for Prod Acct
|
---|
129 | I $L($T(PROD^XUPROD)) S $P(MAGRY,"^",13)=+$$PROD^XUPROD
|
---|
130 | S $P(MAGRY,"^",14)="^"
|
---|
131 | ; AGE
|
---|
132 | S $P(MAGRY,"^",15)=VADM(4)_"^"
|
---|
133 | D KVAR^VADPT,KVA^VADPT
|
---|
134 | I NOLOG ; Don't update session log
|
---|
135 | ; We'll track DFN:ICN
|
---|
136 | E D ACTION^MAGGTAU("PAT^"_DFN_$S(ISICN:"-"_MAGDFN,1:""))
|
---|
137 | Q
|
---|
138 | IMGCT(DFN) ; RETURN TOTAL NUMBER OF IMAGES FOR A PATIENT;
|
---|
139 | ;
|
---|
140 | N I,CT,RDT,PRX,IEN
|
---|
141 | S CT=0
|
---|
142 | S RDT="" F S RDT=$O(^MAG(2005,"APDTPX",DFN,RDT)) Q:RDT="" D
|
---|
143 | . S PRX="" F S PRX=$O(^MAG(2005,"APDTPX",DFN,RDT,PRX)) Q:PRX="" D
|
---|
144 | . . S IEN="" F S IEN=$O(^MAG(2005,"APDTPX",DFN,RDT,PRX,IEN)) Q:IEN="" S CT=CT+1
|
---|
145 | Q CT
|
---|
146 | BS5CHK(MAGRY,MAGDFN) ;RPC [MAGG PAT BS5 CHECK]
|
---|
147 | ; Call to check the BS5 cross ref
|
---|
148 | ; and see if any similar patients exist.
|
---|
149 | ; If yes, all matching patients will be listed and shown to the user.
|
---|
150 | ;
|
---|
151 | N MAGX,MAGDPT,XDFN,XSSN,CT,LNTH
|
---|
152 | S LNTH=0
|
---|
153 | S MAGRY(1)="-1^Error checking cross reference"
|
---|
154 | D GUIBS5A^DPTLK6(.MAGRY,MAGDFN)
|
---|
155 | I MAGRY(1)=0 Q
|
---|
156 | S CT=$O(MAGRY(""),-1)+1
|
---|
157 | S MAGRY(CT)=MAGRY(CT-1),MAGRY(CT-1)="0^ "
|
---|
158 | S I="" F S I=$O(MAGRY(I)) Q:'I D
|
---|
159 | . I $P(MAGRY(I),U)=0 Q
|
---|
160 | . I $L($P(MAGRY(I),U,3))>LNTH S LNTH=$L($P(MAGRY(I),U,3))
|
---|
161 | S LNTH=LNTH+1
|
---|
162 | S I=1 F S I=$O(MAGRY(I)) Q:'I D
|
---|
163 | . I $P(MAGRY(I),U)="0" S MAGRY(I)=$P(MAGRY(I),U,2) Q
|
---|
164 | . S XDFN=$P(MAGRY(I),U,2)
|
---|
165 | . I +XDFN=+MAGDFN S MAGX=" >>>>>> "
|
---|
166 | . E S MAGX=" "
|
---|
167 | . S XSSN=$$SSN^DPTLK1(XDFN) I XSSN?9N S XSSN=$E(XSSN,1,3)_"-"_$E(XSSN,4,5)_"-"_$E(XSSN,6,9)
|
---|
168 | . S MAGDPT=$P(MAGRY(I),U,3),$E(MAGDPT,LNTH)=" "
|
---|
169 | . S MAGX=MAGX_MAGDPT_" "_$$DOB^DPTLK1(XDFN)_" "_XSSN
|
---|
170 | . S MAGRY(I)=MAGX
|
---|
171 | Q
|
---|