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

MAGGTPT1.m

Go to the documentation of this file.
  1. MAGGTPT1 ;WOIFO/GEK/SG/NST/JSL- Delphi-Broker calls for patient lookup and information ; 05 Oct 2010 9:15 AM
  1. ;;3.0;IMAGING;**16,8,92,46,59,93,117,122,131,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. ;
  1. FIND(MAGRY,ZY) ;RPC [MAGG PAT FIND]
  1. ; Call to Do a lookup using FIND^DIC
  1. ; MAGRY is the Array to return.
  1. ; ZY is parameter sent by calling app (Delphi)
  1. ; NUM TO RETURN ^ TEXT TO MATCH ^ TYPE OF OUPUT FORMAT ^ SCREEN ($P 5-99)
  1. ; MAGRY(0)="0^Error message"
  1. ; or
  1. ; MAGRY(0)=Found 100 entries matching "" there are more
  1. ;
  1. ; if $P(ZY,"^",4)'=2 then
  1. ; MAGRY(1..n) = Patient Name _" " _ Date Of Birth _" "_ Male/Female _ " "_ Ward ^ DFN^ICN
  1. ; if $P(ZY,"^",4)=2 then
  1. ; MAGRY(1) = "Patient Name^DOB~S1^Sex^Ward"
  1. ; MAGRY(2..n) = Patient Name^Date Of Birth^Male/Female^Ward | DFN^ICN
  1. N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
  1. ;
  1. N X,Y,I,Z,MAGDFN,WARD
  1. N FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT
  1. N RTYPE,SEX,ICN,PNAME
  1. S (FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT)=""
  1. ;
  1. S FILE=2 ; Patient File
  1. ; Number of entries to return, If 0 we'll stop at 100
  1. S NUM=$S(+$P(ZY,U,1):+$P(ZY,U,1),1:100)
  1. S VAL=$P(ZY,U,2) ; this is the starting value i.e. 'Smi'
  1. S SCR=$P(ZY,U,5,99)
  1. S FLDS=$P(ZY,U,3)
  1. S RTYPE=$P(ZY,U,4)
  1. ;
  1. ;HRN lookup for IHS - HRN is always 1 to 6 numbers - P122
  1. ;Use ^DIC lookup to find patient by MRN
  1. ;If a match is found, set VAL to the patient DFN and continue as usual
  1. I $$ISIHS^MAGSPID() I VAL?1.6N D ;P122 IHS Health Record No - patient lookup
  1. . N DIC S DIC=FILE,DIC(0)="XMF",X=VAL D ^DIC
  1. . I Y>0 S VAL="`"_$P(Y,"^")
  1. . Q
  1. ;
  1. ; If specific fields aren't requested,
  1. ; Get Identifiers, and ward as FLDS
  1. ;I '$L(FLDS) S FLDS=FLDS_";.1;.03;.09;.301;391"
  1. I '$L(FLDS) S FLDS=FLDS_";.1;.02;.301;391"
  1. ; we'll add ACN to the index to search, for ward
  1. ; for speed we'll decide which xref to use
  1. S INDEX=$S(VAL?9N:"SSN^ACN",VAL?1U1.N:"BS5^ACN",1:"B^ACN")
  1. ;
  1. K ^TMP("DILIST",$J)
  1. K ^TMP("DIERR",$J)
  1. ; VAL is the initial value to search for. i.e. the user input.
  1. ; Next line is to stop the FM Infinite Error Trap problem.
  1. I $L(VAL)>30 S MAGRY(0)="0^Invalid: Input '"_$E(VAL,1,40)_"...' is too long. "_$L(VAL)_" characters." Q
  1. D FIND^DIC(FILE,IENS,FLDS,FLAGS,VAL,NUM,INDEX,SCR,IDENT,TROOT)
  1. ;
  1. ; if no Match or ERROR we return 0 as 1st '^' piece.
  1. ;
  1. I '$D(^TMP("DILIST",$J,1)) S I=1 D Q
  1. . I $D(^TMP("DIERR",$J)) D FINDERR(I) Q
  1. . S MAGRY(I)="NO MATCH for lookup on """_$P(ZY,"^",2)_""""
  1. ;
  1. ; so we have some matches, (BUT we could still have an error)
  1. ; so first list all matches, then the Errors, if any.
  1. S I="" F S I=$O(^TMP("DILIST",$J,1,I)) Q:I="" D
  1. . S PNAME=^TMP("DILIST",$J,1,I) ; Name
  1. . S MAGDFN=+^TMP("DILIST",$J,2,I) ; DFN
  1. . S SEX=^TMP("DILIST",$J,"ID",I,.02)
  1. . S WARD=^TMP("DILIST",$J,"ID",I,.1)
  1. . K ^TMP("DILIST",$J,"ID",I,.1)
  1. . S ICN=$S($T(GETICN^MPIF001)="":"-1^NO MPI",1:$$GETICN^MPIF001(MAGDFN)) ;P122 - site not use ICN
  1. . S ICN=$S(ICN'<0:ICN,1:"")
  1. . I RTYPE=2 D
  1. . . S MAGRY(I+1)=PNAME_U_$$DOB^DPTLK1(MAGDFN)_U_SEX_U_WARD_"|"_MAGDFN_U_ICN
  1. . I RTYPE'=2 D
  1. . . S X=PNAME
  1. . . I $E(WARD,1,$L(VAL))=VAL S X=WARD_" "_PNAME
  1. . . N DFN,VA S DFN=MAGDFN D PID^VADPT6 S X=X_" "_$$DOB^DPTLK1(MAGDFN)_" "_VA("PID") ;P122 - Patient ID (VA SSN/IHS HRN)
  1. . . S Z=0
  1. . . ; We are displaying other identifiers with each patient.
  1. . . F S Z=$O(^TMP("DILIST",$J,"ID",I,Z)) Q:Z="" S X=X_" "_^(Z)
  1. . . S MAGRY(I)=X_"^"_(+MAGDFN)_"^"_ICN ;SG
  1. I RTYPE=2 S MAGRY(1)="Patient Name^DOB~S1^Sex^Ward"
  1. ;
  1. I $D(^TMP("DIERR",$J)) D FINDERR() Q
  1. I '$D(^TMP("DILIST",$J,0)) Q
  1. S X=^TMP("DILIST",$J,0)
  1. S I=$O(MAGRY(""),-1)+1
  1. S MAGRY(0)="Found "_$P(X,"^")_" entr"_$S((+X=1):"y",1:"ies")_" matching """_$P(ZY,"^",3)_""""
  1. I $P(X,"^",3)>0 S MAGRY(0)=MAGRY(0)_" there are more"
  1. Q
  1. FINDERR(XI) ;
  1. I '+$G(XI) S XI=$O(MAGRY(""),-1)+1
  1. S MAGRY(XI)="ERROR^"_^TMP("DIERR",$J,1,"TEXT",1)
  1. Q
  1. INFO(MAGRY,DATA) ;RPC [MAGG PAT INFO] Call to Return patient info.
  1. ; Input parameters
  1. ; DATA: MAGDFN ^ NOLOG ^ ISICN ^ FLAGS ^ YYFORMAT
  1. ; MAGDFN -- Patient DFN
  1. ; NOLOG -- 0/1; if 1, then do NOT update the Session log
  1. ; ISICN -- 0/1 if 1, then this is an ICN, if 0 (default) this is a DFN ; Patch 41
  1. ; FLAGS -- "D" Include Deleted images
  1. ; YYFORMAT - 0/1; if 1, return DOB as MM/DD/YYYY not MM/DD/YY (MAG*3.0*118).
  1. ; MAGRY is a string, we return the following :
  1. ; //$P 1 2 3 4 5 6 7 8 9 10
  1. ; // status ^ DFN ^ name ^ sex ^ DOB ^ PID ^ S/C ^ TYPE ^ Veteran(y/n) ^ Patient Image Count
  1. ; //$P 11 12 13 14 15 16
  1. ; ICN SITE Number ^ Production Account 1/0 ^ Not use ^ Age ^ SSN (MUSE) ^
  1. ; VADM(1)=Patient's name
  1. ; VADM(5)=Patient's sex (M^MALE)
  1. ; VADM(3)=Patient's DOB (internal^external)
  1. ; VADM(2)=Patient's SSN (internal^external)
  1. ; VAEL(3)=Patient's Service Connected? (#.301) (1=yes)
  1. ; VAEL(4)=Patient's Veteran Y/N (#1901) (1=yes)
  1. ; VAEL(6)=Patient's Type (#391) (internal^external)
  1. ;
  1. N MAGDFN,DFN,X,NOLOG,VADM,VAEL,VAERR,ISICN,FLAGS,YYFORMAT
  1. S MAGDFN=$P(DATA,U),NOLOG=+$P(DATA,U,2),ISICN=+$P(DATA,U,3),FLAGS=$P(DATA,U,4),YYFORMAT=+$P(DATA,U,5)
  1. I ISICN D GETDFN^VAFCTFU1(.DFN,MAGDFN)
  1. E S DFN=+MAGDFN
  1. D DEM^VADPT,ELIG^VADPT
  1. I VAERR S MAGRY="0^"_"Entry not found in Patient file." Q
  1. ;--- Format year as ..... YYYY or YY.
  1. S YYFORMAT=$S(YYFORMAT=1:"5DZ",1:"2DZ")
  1. S X=$$FMTE^XLFDT($P(VADM(3),"^"),YYFORMAT)
  1. ; 140 Reformat for easy reading.
  1. S $P(MAGRY,"^",1)="1" ; Status
  1. S $P(MAGRY,"^",2)=DFN ; DFN
  1. S $P(MAGRY,"^",3)=$G(VADM(1)) ; Patient Name
  1. S $P(MAGRY,"^",4)=$P(VADM(5),"^",2) ; Sex
  1. S $P(MAGRY,"^",5)=X ; DOB
  1. S $P(MAGRY,"^",6)=$S($$ISIHS^MAGSPID():VA("PID"),1:$P(VADM(2),"^")) ;P122 $sel(IHS,VA)
  1. S $P(MAGRY,"^",7)=$S(+VAEL(3):"YES",1:"") ; S/C
  1. S $P(MAGRY,"^",8)=$P(VAEL(6),"^",2) ; TYPE
  1. S $P(MAGRY,"^",9)=$S(+VAEL(4):"YES",1:"") ; Veteran(y/n)
  1. S $P(MAGRY,"^",10)=$$IMGCT(DFN,FLAGS) ; Patient Image Count
  1. S $P(MAGRY,"^",11)=$S($T(GETICN^MPIF001)'="":$$GETICN^MPIF001(DFN),1:"") ; P122 site may not implemented MPI
  1. S X=$$SITE^VASITE
  1. S $P(MAGRY,"^",12)=$P($G(X),"^",3) ; Site Number
  1. S $P(MAGRY,"^",13)="1" ; We'll default to Production Account = Yes.
  1. ; NEED KERNEL PATCH XU*8.0*284 FOR PROD^XUPROD
  1. I $L($T(PROD^XUPROD)) S $P(MAGRY,"^",13)=+$$PROD^XUPROD
  1. S $P(MAGRY,"^",14)="" ; Null
  1. S $P(MAGRY,"^",15)=VADM(4) ; Age
  1. S $P(MAGRY,"^",16)=$P(VADM(2),U) ; SSN (9N no dashes) for MUSE(EKG) Patient ID
  1. S MAGRY=MAGRY_"^" ; ALWAYS put '^' on end of '^' delimited string for Delphi Client.
  1. ;
  1. D KVAR^VADPT,KVA^VADPT
  1. I NOLOG ; Don't update session log
  1. ; We'll track DFN:ICN
  1. E D ACTION^MAGGTAU("PAT^"_DFN_$S(ISICN:"-"_MAGDFN,1:""))
  1. Q
  1. IMGCT(DFN,FLAGS) ; RETURN TOTAL NUMBER OF IMAGES FOR A PATIENT;
  1. ; FLAGS D Include deleted images (file #2005.1)
  1. ;
  1. N MAG8BOTH,MAG8ROOT,MAG8XREF,CNT
  1. N MAG8DT,MAG8PRX,MAG8IEN
  1. ;
  1. S CNT=0
  1. S MAG8BOTH=(FLAGS["D")
  1. S MAG8ROOT=$NA(^MAG(2005))
  1. I DFN>0 D
  1. . S MAG8XREF=$NA(@MAG8ROOT@("APDTPX",+DFN))
  1. . ;---
  1. . S (MAG8DT,MAG8PRX,MAG8IEN)=""
  1. . F S MAG8DT=$$MAGORD^MAGGI13($NA(@MAG8XREF@(MAG8DT)),1,MAG8BOTH) Q:MAG8DT="" D
  1. . . F S MAG8PRX=$$MAGORD^MAGGI13($NA(@MAG8XREF@(MAG8DT,MAG8PRX)),1,MAG8BOTH) Q:MAG8PRX="" D
  1. . . . F S MAG8IEN=$$MAGORD^MAGGI13($NA(@MAG8XREF@(MAG8DT,MAG8PRX,MAG8IEN)),1,MAG8BOTH) Q:MAG8IEN="" D
  1. . . . . I +$$IMGST^MAGGI11(MAG8IEN)=13 Q ; Quit if STATUS in (2005|2005.1)=13 (Image never existed)
  1. . . . . I $$ISDEL^MAGGI11(MAG8IEN) S:MAG8BOTH CNT=CNT+1 Q ; Include deleted images
  1. . . . . S CNT=CNT+1
  1. . . . . Q
  1. . . . Q
  1. . . Q
  1. . Q
  1. Q CNT
  1. BS5CHK(MAGRY,MAGDFN) ;RPC [MAGG PAT BS5 CHECK]
  1. ; Call to check the BS5 cross ref
  1. ; and see if any similar patients exist.
  1. ; If yes, all matching patients will be listed and shown to the user.
  1. ;
  1. N MAGX,MAGDPT,XDFN,XPID,CT,LNTH
  1. S LNTH=0
  1. S MAGRY(1)="-1^Error checking cross reference"
  1. D GUIBS5A^DPTLK6(.MAGRY,MAGDFN)
  1. I MAGRY(1)=0 Q
  1. S CT=$O(MAGRY(""),-1)+1
  1. S MAGRY(CT)=MAGRY(CT-1),MAGRY(CT-1)="0^ "
  1. S I="" F S I=$O(MAGRY(I)) Q:'I D
  1. . I $P(MAGRY(I),U)=0 Q
  1. . I $L($P(MAGRY(I),U,3))>LNTH S LNTH=$L($P(MAGRY(I),U,3))
  1. S LNTH=LNTH+1
  1. S I=1 F S I=$O(MAGRY(I)) Q:'I D
  1. . I $P(MAGRY(I),U)="0" S MAGRY(I)=$P(MAGRY(I),U,2) Q
  1. . S XDFN=$P(MAGRY(I),U,2)
  1. . I +XDFN=+MAGDFN S MAGX=" >>>>>> "
  1. . E S MAGX=" "
  1. . N DFN,VA S DFN=XDFN D PID^VADPT6 S XPID=VA("PID") ;P122 - Patient (VA SSN/IHS HRN)
  1. . I XPID?9N S XPID=$E(XPID,1,3)_"-"_$E(XPID,4,5)_"-"_$E(XPID,6,9)
  1. . S MAGDPT=$P(MAGRY(I),U,3),$E(MAGDPT,LNTH)=" "
  1. . S MAGX=MAGX_MAGDPT_" "_$$DOB^DPTLK1(XDFN)_" "_XPID
  1. . S MAGRY(I)=MAGX
  1. Q