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