| 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 | 
|---|