source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGTPT1.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 7.3 KB
Line 
1MAGGTPT1 ;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 ;
21FIND(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
83FINDERR(XI) ;
84 I '+$G(XI) S XI=$O(MAGRY(""),-1)+1
85 S MAGRY(XI)="ERROR^"_^TMP("DIERR",$J,1,"TEXT",1)
86 Q
87INFO(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
138IMGCT(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
146BS5CHK(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
Note: See TracBrowser for help on using the repository browser.