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

MAGDSTQA.m

Go to the documentation of this file.
  1. MAGDSTQA ;WOIFO/PMK - Study Tracker - Query/Retrieve user patient lookup ; Aug 30, 2020@17:57:08
  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. ; Notice: This routine is on both VistA and the DICOM Gateway
  1. ;
  1. ; RPC version of ^MAGDSTA3 on VistA
  1. ;
  1. ; Supported IA #3027 reference DG SENSITIVE RECORD ACCESS rpc
  1. ; Supported IA #3027 reference PTSEC^DGSEC4 subroutine call
  1. ; Supported IA #3027 reference DG SENSITIVE RECORD BULLETIN rpc
  1. ; Supported IA #3027 reference NOTICE^DGSEC4 subroutine call
  1. ; Supported IA #10103 reference $$FMTE^XLFDT function call
  1. Q
  1. ;
  1. ; Entry point from ^MAGDSTA1 for automatic (batch) Q/R client
  1. PATIENTA ; need just DFN for current patient, no previous PII
  1. N CLIENT S CLIENT="AUTOMATIC"
  1. N CHANGED,CHANGEDATE,DFN,DOB,DOD,FINIS,IPATINFO,K,PATINFO,PROMPT
  1. ;
  1. ; IPATINFO and PATINFO are not used in this subroutine
  1. ;
  1. S DFN=$G(^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN"))
  1. S PROMPT="patient"
  1. S IPATINFO=$$PATIENT(.PATINFO,DFN)
  1. Q
  1. ;
  1. PATIENT(PATINFO,DFN) ; look up the patients
  1. N DOB,DONE,I,NAME,RETURN,RPCERR,SENSITIVE,SEX,SSN,VA,VADM,VAERR,X
  1. S DFN=$G(DFN),RETURN=0
  1. I DFN'="" D
  1. . W !!,"The patient is currently defined as follows: "
  1. . I $$VISTA^MAGDSTQ D ; VistA code - call API
  1. . . D PAT^MAGDRPC1(.VAINFO,DFN)
  1. . . Q
  1. . E D ; DICOM Gateway code - call RPC
  1. . . S RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM GET PATIENT","M",.VAINFO,DFN)
  1. . . I RPCERR<0 D S RETURN=-1 Q
  1. . . . D ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM GET PATIENT rpc",.VAINFO)
  1. . . . Q
  1. . . Q
  1. . I RETURN Q
  1. . D VADPT^MAGDRPC0(.VAINFO)
  1. . S VAICN=$G(VAICN)
  1. . D SCREEN(.SENSITIVE,DFN)
  1. . S NAME=VADM(1),DOB=$P(VADM(3),"^",2),SSN=$P(VADM(2),"^",2)
  1. . S SEX=$P(VADM(5),"^",1)
  1. . K PATINFO
  1. . D SAVEINFO(.PATINFO,DFN,NAME,DOB,SSN,SEX,,SENSITIVE)
  1. . W !! D PRINTHDR
  1. . D PRINTPAT(.PATINFO,1)
  1. . I $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0 S QUIT=1 Q
  1. . I X="YES" D
  1. . . S RETURN=$$PATIENT1(.PATINFO)
  1. . . Q
  1. . E D ; save info
  1. . . S RETURN=1
  1. . Q
  1. E D
  1. . S RETURN=$$PATIENT1(.PATINFO)
  1. . Q
  1. Q RETURN
  1. ;
  1. PATIENT1(PATINFO) ; lookup patient
  1. N I,IN,OK,RETURN,X
  1. S OK=0 F D Q:OK
  1. . W !!,"Enter Patient: "
  1. . R X:DTIME E S X="^"
  1. . I X["^" S OK=-1 Q
  1. . I X="@" D Q
  1. . . F I="PATIENT NAME","PATIENT ID","PATIENT BIRTH DATE","PATIENT'S SEX","PATIENT DFN" D
  1. . . . K ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,I)
  1. . . . Q
  1. . . K ^TMP("MAG",$J,"Q/R PARAM","PATIENT LOOKUP MODE") ; reset VistA/Manual Mode
  1. . . S DFN="",OK=-2
  1. . . Q
  1. . I "?"[X D Q
  1. . . W !!,"Enter either the Patient Name (last,first), the Social Security Number,"
  1. . . W !,"or the Quick PID (initial + last four). You may use ""@"" to remove it."
  1. . . Q
  1. . S X=$TR(X,"-") ; remove dashes in SSN for lookup
  1. . D PATLKUP(.PATINFO,X)
  1. . S RETURN=$$PATIENT2("PATIENTS",.PATINFO,"") ; no default (3rd argument)
  1. . Q
  1. I OK<0 D
  1. . S QUIT=1
  1. . S RETURN=0
  1. . Q
  1. Q RETURN
  1. ;
  1. PATIENT2(LISTMODE,INFO,DEFAULT) ; called to display a list of patients or a list of PII changes
  1. ; INFO can be either PATINFO or HISTINFO, same format
  1. N COUNT
  1. S COUNT=$G(INFO(0)),DEFAULT=$G(DEFAULT)
  1. I LISTMODE="PATIENTS" D I 'COUNT Q 0
  1. . I 'COUNT W " -- NO MATCH"
  1. . E W " -- ",COUNT," MATCH" W:COUNT>1 "ES"
  1. . Q
  1. I COUNT=1 D
  1. . S RETURN=$$SINGLE(LISTMODE,.INFO,1)
  1. . Q
  1. E D
  1. . S RETURN=$$MULTIPLE(LISTMODE,.INFO,DEFAULT)
  1. . Q
  1. Q RETURN
  1. ;
  1. SINGLE(LISTMODE,INFO,I) ; single match
  1. N DATETIME,FIRSTDAY,FIRSTIEN,LASTDAY,LASTIEN,RETURN,STUDYCOUNT
  1. S DFN=$P(INFO(I),"^",1),SENSITIVE=$P(INFO(I),"^",7)
  1. W !! D PRINTHDR
  1. D PRINTPAT(.INFO,I)
  1. I SENSITIVE D I 'RETURN Q RETURN
  1. . S RETURN=$$PATCHECK(DFN) Q:'RETURN
  1. . W !! D PRINTHDR
  1. . D PRINTPAT(.INFO,I,1)
  1. . W ?65,"*SENSITIVE*"
  1. . Q
  1. I CLIENT="AUTOMATIC" D
  1. . S RETURN=$$SINGLEA
  1. . Q
  1. E D ; CLIENT="MANUAL"
  1. . S RETURN=$$SINGLEQ
  1. . Q
  1. Q RETURN
  1. ;
  1. SINGLEA() ; automatic (batch) query retrieve
  1. ; check for radiology or consults
  1. I IMAGINGSERVICE="RADIOLOGY" D ; look for radiology reports in the range
  1. . D RADLKUP^MAGDSTA4(DFN,.STUDYCOUNT,.FIRSTDAY,.LASTDAY,.FIRSTIEN,.LASTIEN)
  1. . Q
  1. E D ; look for consults/procedures in the range
  1. . D CONLKUP^MAGDSTA6(DFN,.STUDYCOUNT,.FIRSTDAY,.LASTDAY,.FIRSTIEN,.LASTIEN)
  1. . Q
  1. ;
  1. I 'STUDYCOUNT S RETURN=0
  1. E D
  1. . I $$YESNO^MAGDSTQ("Is this the correct "_PROMPT_"?","n",.X)>0,X="YES" D
  1. . . S RETURN=I
  1. . . S ^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN")=$P(INFO(I),"^",1)
  1. . . S ^TMP("MAG",$J,"BATCH Q/R","BEGIN DATE")=FIRSTDAY
  1. . . S ^TMP("MAG",$J,"BATCH Q/R","END DATE")=LASTDAY+.235959 ; end of day
  1. . . S (DONE,FINIS,OK)=1
  1. . . Q
  1. . E S RETURN=0
  1. . Q
  1. Q RETURN
  1. ;
  1. SINGLEQ() ; manual query retrieve
  1. I $$YESNO^MAGDSTQ("Is this the correct "_PROMPT_"?","n",.X)>0,X="YES" D
  1. . S RETURN=I
  1. . S (DONE,FINIS,OK)=1
  1. . Q
  1. E S RETURN=0
  1. Q RETURN
  1. ;
  1. PATCHECK(DFN) ; check patient sensitivity
  1. N NOTICE,SECINFO,PATCHECK,X
  1. I $D(PATCHECKED(DFN)) Q 1 ; patient already checked
  1. ;
  1. I $$VISTA^MAGDSTQ D ; VistA code
  1. . D PTSEC^DGSEC4(.SECINFO,DFN,1,"^VistA Query/Retrieve Client") ; ICR #3027
  1. . Q
  1. E D I SECINFO(1)=-1 D Q 0 ; DICOM Gateway code
  1. . S X=$$CALLRPC^MAGM2VCU("DG SENSITIVE RECORD ACCESS","M",.SECINFO,DFN,1,"^DICOM Gateway Query/Retrieve Client")
  1. . I SECINFO(1)=-1 D Q ; RPC failed
  1. . . D ERRORMSG^MAGDSTQ0(1,"Error in DG SENSITIVE RECORD ACCESS rpc",.SECINFO)
  1. . . Q
  1. . Q
  1. I SECINFO(1) D I 'PATCHECK Q 0
  1. . N I
  1. . W ! S I=1 F S I=$O(SECINFO(I)) Q:I="" D
  1. . . ; write sensitive patient warning message
  1. . . W !?(IOM-$L(SECINFO(I))/2),SECINFO(I)
  1. . . Q
  1. . I SECINFO(1)=1 D CONTINUE^MAGDSTQ S PATCHECK=1 Q
  1. . I SECINFO(1)'=2 D CONTINUE^MAGDSTQ S PATCHECK=0 Q
  1. . I $$YESNO^MAGDSTQ("Do you want to continue processing this patient record?","n",.X)<0 S PATCHECK=0 Q
  1. . I X="NO" S PATCHECK=0 Q
  1. . I $$VISTA^MAGDSTQ D ; VistA code
  1. . . D NOTICE^DGSEC4(.NOTICE,DFN,"^VistA Query/Retrieve Client",1) ; ICR #3027
  1. . . Q
  1. . E D ; DICOM Gateway code
  1. . . S X=$$CALLRPC^MAGM2VCU("DG SENSITIVE RECORD BULLETIN","M",.NOTICE,DFN,"^DICOM Gateway Query/Retrieve Client",1)
  1. . . I 'NOTICE D S PATCHECK=0 Q ; RPC error
  1. . . . D ERRORMSG^MAGDSTQ0(1,"Error in DG SENSITIVE RECORD BULLETIN rpc",.NOTICE)
  1. . . . Q
  1. . . Q
  1. . S PATCHECK=1
  1. . Q
  1. E S PATCHECK=1
  1. I PATCHECK S PATCHECKED(DFN)=1
  1. Q PATCHECK
  1. ;
  1. MULTIPLE(LISTMODE,INFO,DEFAULT) ; display information for multiple patients/pii changes
  1. N DONE,RETURN
  1. S (DONE,RETURN)=0
  1. I LISTMODE="PATIENTS" W !!,"There are ",COUNT," matches"
  1. E W !!,"There are changes in the patient identification"
  1. R "... Press <Enter> for list",X:$G(DTIME,300)
  1. I COUNT>20 D ; more than twenty patients/pii changes
  1. . F K=1:20:COUNT S RETURN=$$MULTI(DEFAULT) Q:DONE
  1. . Q
  1. E D ; twenty or less patients
  1. . S K=1 S RETURN=$$MULTI(DEFAULT) Q:DONE
  1. Q RETURN
  1. ;
  1. MULTI(DEFAULT) ; display one set of patients
  1. N I,K20,FINIS,RETURN
  1. S RETURN=0
  1. S K20=K+19 I K20>COUNT S K20=COUNT
  1. S FINIS=0 F D Q:FINIS
  1. . W @IOF D PRINTHDR
  1. . F I=K:1:K20 D
  1. . . D PRINTPAT(.INFO,I)
  1. . W !!,"Enter 1-",K20," to select the ",PROMPT
  1. . I K20<COUNT W ", or <Enter> to see more ",PROMPT,"s"
  1. . W ": " I DEFAULT'="" W DEFAULT,"// "
  1. . R I:$G(DTIME,300) E S I="^"
  1. . I I="" W DEFAULT S I=DEFAULT
  1. . I I="" S FINIS=1 Q
  1. . I I["^" S DONE=1,I="",FINIS=-1 Q
  1. . I I?1N.N,I'<1,I'>K20 S RETURN=$$SINGLE(LISTMODE,.INFO,I) Q
  1. . W " ???" R X:$G(DTIME,300)
  1. . Q
  1. Q RETURN
  1. ;
  1. PRINTHDR ; print column header
  1. W ?4,"Social Sec#",?16,"Sex",?21,"Patient's Name",?53,"Birth Date"
  1. I $G(LISTMODE)="PII CHANGES" W ?65,"Change Date"
  1. W !?4,"-----------",?16,"---",?21,"--------------",?53,"----------"
  1. I $G(LISTMODE)="PII CHANGES" W ?65,"---------------"
  1. Q
  1. ;
  1. PRINTPAT(INFO,I,SENSITIVEOK) ; print patient information
  1. N X
  1. D GETINFO(.INFO,I)
  1. ;
  1. I '$G(SENSITIVEOK),SENSITIVE D
  1. . W !,$J(I,2),")",?4,"*SENSITIVE*",?17,$E(SEX,1),?21,$E(NAME,1,30),?53,"*SENSITIVE*"
  1. . Q
  1. E D
  1. . W !,$J(I,2),")",?4,SSN,?17,$E(SEX,1),?21,$E(NAME,1,30),?53,DOB
  1. . Q
  1. I $G(LISTMODE)="PII CHANGES" D
  1. . I CHANGED'="" D
  1. . . W ?65,CHANGED,?70,"- ",$$CHANGEDT(CHANGEDATE)
  1. . . Q
  1. . E W ?72,$$CHANGEDT(CHANGEDATE)
  1. . Q
  1. Q
  1. ;
  1. SAVEINFO(INFO,DFN,NAME,DOB,PID,SEX,DOD,SENSITIVE,CHANGED,CHANGEDATE) ; save pii
  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. N X
  1. I DOB?1"00/00/"4N S DOB=$E(DOB,7,10) ; only year
  1. S X=DFN_"^"_NAME_"^"_DOB_"^"_PID_"^"_SEX_"^"_$G(DOD)
  1. S X=X_"^"_$G(SENSITIVE)_"^"_$G(CHANGED)_"^"_$G(CHANGEDATE)
  1. S INFO(0)=$G(INFO(0))+1
  1. S INFO(INFO(0))=X
  1. Q
  1. ;
  1. GETINFO(INFO,I) ; retrieve pii
  1. S X=INFO(I),DFN=$P(X,"^",1),NAME=$P(X,"^",2),DOB=$P(X,"^",3)
  1. S SSN=$P(X,"^",4),SEX=$P(X,"^",5),DOD=$P(X,"^",6)
  1. S SENSITIVE=$P(X,"^",7),CHANGED=$P(X,"^",8),CHANGEDATE=$P(X,"^",9)
  1. Q
  1. ;
  1. CHANGEDT(X) ; return change date in mm/dd/yy format
  1. S X=$$FMTE^XLFDT(X,"5Z")
  1. Q $E(X,1,6)_$E(X,9,10)
  1. ;
  1. PATLKUP(OUTPUT,INPUT) ; patient lookup
  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. I $$VISTA^MAGDSTQ D ; VistA code - call API
  1. . D PATLKUP^MAGDSTA3(.OUTPUT,INPUT)
  1. . Q
  1. E D ; DICOM Gateway code - call RPC
  1. . N ARRAY,COUNT,I,RPCERR
  1. . K OUTPUT
  1. . S RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM PATIENT LOOKUP","MT",.ARRAY,INPUT)
  1. . I RPCERR<0 D S OUTPUT(0)=-1 Q
  1. . . D ERRORMSG^MAGDSTQ0(1,"Error in rpc MAG DICOM PATIENT LOOKUP",.ARRAY)
  1. . . Q
  1. . S COUNT=ARRAY(1)
  1. . F I=0:1:COUNT S OUTPUT(I)=ARRAY(I+1)
  1. . Q
  1. Q
  1. ;
  1. SCREEN(SCREEN,DFN) ; 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. I $$VISTA^MAGDSTQ D ; VistA code - call API
  1. . D SCREEN^MAGDSTA3(.SCREEN,DFN)
  1. . Q
  1. E D ; DICOM Gateway code - call RPC
  1. . N RPCERR
  1. . S RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM GET PT SENSITIVITY","M",.SCREEN,DFN)
  1. . I RPCERR<0 D S SCREEN=-1
  1. . . D ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM GET PT SENSITIVITY rpc",.SCREEN)
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. ;
  1. ;
  1. HISTLKUP(OUTPUT,DFN) ; 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. I $$VISTA^MAGDSTQ D ; VistA code - call API
  1. . D HISTLKUP^MAGDSTA3(.OUTPUT,DFN)
  1. . Q
  1. E D ; DICOM Gateway code - call RPC
  1. . N ARRAY,COUNT,I,RPCERR
  1. . K OUTPUT
  1. . S RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM PATIENT HISTORY","MT",.ARRAY,DFN)
  1. . I RPCERR<0 D S OUTPUT(0)=-1 Q
  1. . . D ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM PATIENT HISTORY rpc",.ARRAY)
  1. . . Q
  1. . S COUNT=ARRAY(1)
  1. . F I=0:1:COUNT S OUTPUT(I)=ARRAY(I+1)
  1. . Q
  1. Q