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

MAGDSTA3.m

Go to the documentation of this file.
  1. MAGDSTA3 ;WOIFO/PMK - Study Tracker - Query/Retrieve user patient lookup ; Jun 01, 2020@12:10:06
  1. ;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Feb 27, 2015
  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. ;
  1. ; API's and RPC'S for MAGDSTQA VistA PII lookup routine
  1. ;
  1. ; Supported IA #3646 reference $$EMPL^DGSEC4 function call
  1. ; Supported IA #767 Reading DG SECURITY LOG ^DGSL(38.1,DFN,0)
  1. ; Supported IA #2051 reference FIND^DIC subroutine call
  1. ; Supported IA #2054 reference CLEAN^DILF subroutine call
  1. ; Supported IA #10061 reference DEM^VADPT subroutine call
  1. ; Supported IA #10035 for Fileman reads of ^DPT
  1. ; Supported IA #10103 reference $$FMTE^XLFDT function call
  1. ; Supported IA #2602 Reading AUDIT file (#1.1) ^DIA(2,...)
  1. ; Supported IA #3065 reference $$HLNAME^XLFNAME function call
  1. ;
  1. Q
  1. ;
  1. PATLKUP(OUTPUT,INPUT) ; RPC = MAG DICOM PATIENT LOOKUP
  1. ; patient lookup
  1. ; modified from FINDP^SCUTBK11 for SC PATIENT LOOKUP rpc
  1. ;
  1. ; INPUT = value to lookup
  1. ; Lookup uses multiple index lookup of File #2
  1. ;
  1. ; OUTPUT = data
  1. ; OUTPUT(0) = number of records
  1. ; for i=1:number of records returned:
  1. ; DFN^patient name^DOB^PID^SEX^DOD^Sensitive
  1. ; 1 2 3 4 5 6 7
  1. ;
  1. ; (DOD = Date of Death)
  1. ;
  1. K OUTPUT
  1. D FIND^DIC(2,,".01;.03;.363;.09;.02;.351","PS",INPUT,300,"B^BS^BS5^SSN")
  1. I $G(DIERR) D CLEAN^DILF Q
  1. N SCOUNT S SCOUNT=+^TMP("DILIST",$J,0)
  1. N SC F SC=1:1:SCOUNT D
  1. . N NODE,DASHSSN,DFN,DOB,DOD,NAME,PID,PRILONGID,SENSITIVE,SEX,SSN
  1. . S NODE=^TMP("DILIST",$J,SC,0)
  1. . ; IEN^NAME^DOB^Primary Long ID^SSN^SEX^DOD
  1. . ; 1 2 3 4 5 6 7
  1. . S DFN=$P(NODE,"^",1),NAME=$P(NODE,"^",2)
  1. . S DOB=$P(NODE,"^",3),DOD=$P(NODE,"^",4)
  1. . S SSN=$P(NODE,"^",5),SEX=$P(NODE,"^",6)
  1. . S DASHSSN=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,11)
  1. . S PRILONGID=$P(NODE,"^",4)
  1. . I $E(SSN,1,9)'?9N S (DASHSSN,PRILONGID)=SSN
  1. . S PID=$S($L(PRILONGID)>5:PRILONGID,1:DASHSSN)
  1. . D SCREEN(.SENSITIVE,DFN)
  1. . D SAVEINFO^MAGDSTQA(.OUTPUT,DFN,NAME,DOB,PID,SEX,DOD,SENSITIVE)
  1. . Q
  1. S OUTPUT(0)=SCOUNT
  1. K ^TMP("DILIST",$J)
  1. Q
  1. ;
  1. SCREEN(SCREEN,DFN) ; RPC = MAG DICOM GET PT SENSITIVITY
  1. ; Screening logic sensitive patients
  1. ; Input : DFN - Pointer to PATIENT file (#2)
  1. ; Output : 0 - Don't apply screen
  1. ; 1 - Apply screen - sensitive patient
  1. ; 2 - Apply screen - employee
  1. ; Notes : Screen applied if patient is sensitive or an employee
  1. ;
  1. N DGTIME,DGT,DGA1,DG1,DGXFR0
  1. ; Sensitive - screen
  1. I $P($G(^DGSL(38.1,DFN,0)),"^",2) S SCREEN=1 Q
  1. ; Employee - screen
  1. I $$EMPL^DGSEC4(DFN) S SCREEN=2 Q
  1. ;Don't screen
  1. S SCREEN=0
  1. Q
  1. ;
  1. ;
  1. ;
  1. HISTLKUP(PII,DFN) ; RPC = MAG DICOM PATIENT HISTORY
  1. ; look up historical patient changes in the audit archive
  1. ; INPUT = value to lookup
  1. ; Lookup uses multiple index lookup of File #2
  1. ;
  1. ; OUTPUT = data
  1. ; OUTPUT(0) = number of records
  1. ; for i=1:number of records returned:
  1. ; DFN^Patient Name^DOB^PID^SEX^DOD^Sensitive^Changed Field^Change date & time
  1. ; 1 2 3 4 5 6 7 8 9
  1. ;
  1. ; (DOD = Date of Death; DOD and Sensitive are null)
  1. ;
  1. N DOB,NAME,SEX,SSN,VA,VADM,VAERR,X
  1. N DATETIME ; date and time of the SSN change
  1. N DIAIEN ; ien of the record in the AUDIT file (#1.1)
  1. N FIELDNUMBER ; SSN is field .09 in the PATIENT file (#2)
  1. N FIELD ; name of MUMPS FIELD holding the field data
  1. N OLD,NEW ; previous and new field value
  1. ;
  1. K PII S PII(0)=0
  1. ; save current PII
  1. D DEM^VADPT
  1. S NAME=VADM(1)
  1. S SSN=$P(VADM(2),"^",2) ; with dashes
  1. S DOB=$P(VADM(3),"^",1),DOB=$$FMTE^XLFDT(DOB,"5Z") ; MM/DD/YYYY format
  1. I DOB?1"00/00/"4N S $P(NODE,"^",3)=$E(DOB,7,10) ; only year
  1. S SEX=$P(VADM(5),"^",2)
  1. D SAVEINFO^MAGDSTQA(.PII,DFN,NAME,DOB,SSN,SEX,,,,"(todayCC)") ; CC is not displayed
  1. ;
  1. ; save PII changes
  1. S DIAIEN="" F S DIAIEN=$O(^DIA(2,"B",DFN,DIAIEN),-1) Q:DIAIEN="" D
  1. . S X=$G(^DIA(2,DIAIEN,0))
  1. . S CHANGEDATE=$P(X,"^",2),FIELDNUMBER=$P(X,"^",3)
  1. . S NEW=$G(^DIA(2,DIAIEN,2)),OLD=$G(^DIA(2,DIAIEN,3))
  1. . I FIELDNUMBER=.01 S CHANGED="NAME" ; name change record
  1. . E I FIELDNUMBER=.02 S CHANGED="SEX" ; sex change record
  1. . E I FIELDNUMBER=.03 S CHANGED="DOB" ; dob change record
  1. . E I FIELDNUMBER=.09 S CHANGED="SSN" D ; SSN change record
  1. . . S OLD=$E(OLD,1,3)_"-"_$E(OLD,4,5)_"-"_$E(OLD,6,10) ; remember "P"
  1. . . S NEW=$E(NEW,1,3)_"-"_$E(NEW,4,5)_"-"_$E(NEW,6,10) ; remember "P"
  1. . . Q
  1. . E Q ; other field
  1. . I OLD'=@CHANGED W !?10,"Old ",CHANGED," not matching: ",OLD," to ",@CHANGED
  1. . S @CHANGED=NEW
  1. . D SAVEINFO^MAGDSTQA(.PII,DFN,NAME,DOB,SSN,SEX,,,CHANGED,CHANGEDATE)
  1. . Q
  1. Q
  1. ;
  1. DCMNAME(OUT,DFN) ; RPC = MAG DICOM FORMAT PATIENT NAME
  1. ; get properly formatted DICOM patient name
  1. ; HL7: family ^ given ^ middle ^ suffix ^ prefix ^ degree
  1. ; DICOM: family ^ given ^ middle ^ prefix ^ suffix (4 & 5 swapped, no degree)
  1. N DGNAME,DICOMNAME,HL7NAME
  1. K OUT
  1. I '$G(DFN) S OUT="-1,No Patient Identified" Q
  1. S DGNAME("FILE")=2,DGNAME("IENS")=DFN,DGNAME("FIELD")=.01
  1. S HL7NAME=$$HLNAME^XLFNAME(.DGNAME,"","^") ; get HL7 formatted name
  1. I HL7NAME="" S OUT="-2,No patient found with DFN="_DFN Q
  1. ; convert to DICOM format by swapping 4th and 5th components
  1. S DICOMNAME=$P(HL7NAME,"^",1,3) ; family ^ given ^ middle
  1. S $P(DICOMNAME,"^",4)=$P(HL7NAME,"^",5) ; prefix (e.g., DR)
  1. S $P(DICOMNAME,"^",5)=$P(HL7NAME,"^",4) ; suffix (e.g., JR or III)
  1. S OUT=DICOMNAME
  1. Q
  1. ;
  1. ANPREFIX(OUT) ; RPC = MAG DICOM GET ACN PREFIX
  1. ; Get the value of the accession number prefix
  1. S OUT=$$ANPREFIX^MAGDSTAB
  1. Q
  1. ;
  1. DASHES(OUT) ; RPC = MAG DICOM GET PT ID DASHES
  1. ; Get the value of the patient identifier dashes
  1. S OUT=$$DASHES^MAGDSTAB
  1. Q