- MAGDSTQA ;WOIFO/PMK - Study Tracker - Query/Retrieve user patient lookup ; Aug 30, 2020@17:57:08
- ;;3.0;IMAGING;**231**;Mar 19, 2002;Build 9;Feb 27, 2015
- ;; 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. |
- ;; +---------------------------------------------------------------+
- ;;
- ;
- ; Notice: This routine is on both VistA and the DICOM Gateway
- ;
- ; RPC version of ^MAGDSTA3 on VistA
- ;
- ; Supported IA #3027 reference DG SENSITIVE RECORD ACCESS rpc
- ; Supported IA #3027 reference PTSEC^DGSEC4 subroutine call
- ; Supported IA #3027 reference DG SENSITIVE RECORD BULLETIN rpc
- ; Supported IA #3027 reference NOTICE^DGSEC4 subroutine call
- ; Supported IA #10103 reference $$FMTE^XLFDT function call
- Q
- ;
- ; Entry point from ^MAGDSTA1 for automatic (batch) Q/R client
- PATIENTA ; need just DFN for current patient, no previous PII
- N CLIENT S CLIENT="AUTOMATIC"
- N CHANGED,CHANGEDATE,DFN,DOB,DOD,FINIS,IPATINFO,K,PATINFO,PROMPT
- ;
- ; IPATINFO and PATINFO are not used in this subroutine
- ;
- S DFN=$G(^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN"))
- S PROMPT="patient"
- S IPATINFO=$$PATIENT(.PATINFO,DFN)
- Q
- ;
- PATIENT(PATINFO,DFN) ; look up the patients
- N DOB,DONE,I,NAME,RETURN,RPCERR,SENSITIVE,SEX,SSN,VA,VADM,VAERR,X
- S DFN=$G(DFN),RETURN=0
- I DFN'="" D
- . W !!,"The patient is currently defined as follows: "
- . I $$VISTA^MAGDSTQ D ; VistA code - call API
- . . D PAT^MAGDRPC1(.VAINFO,DFN)
- . . Q
- . E D ; DICOM Gateway code - call RPC
- . . S RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM GET PATIENT","M",.VAINFO,DFN)
- . . I RPCERR<0 D S RETURN=-1 Q
- . . . D ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM GET PATIENT rpc",.VAINFO)
- . . . Q
- . . Q
- . I RETURN Q
- . D VADPT^MAGDRPC0(.VAINFO)
- . S VAICN=$G(VAICN)
- . D SCREEN(.SENSITIVE,DFN)
- . S NAME=VADM(1),DOB=$P(VADM(3),"^",2),SSN=$P(VADM(2),"^",2)
- . S SEX=$P(VADM(5),"^",1)
- . K PATINFO
- . D SAVEINFO(.PATINFO,DFN,NAME,DOB,SSN,SEX,,SENSITIVE)
- . W !! D PRINTHDR
- . D PRINTPAT(.PATINFO,1)
- . I $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0 S QUIT=1 Q
- . I X="YES" D
- . . S RETURN=$$PATIENT1(.PATINFO)
- . . Q
- . E D ; save info
- . . S RETURN=1
- . Q
- E D
- . S RETURN=$$PATIENT1(.PATINFO)
- . Q
- Q RETURN
- ;
- PATIENT1(PATINFO) ; lookup patient
- N I,IN,OK,RETURN,X
- S OK=0 F D Q:OK
- . W !!,"Enter Patient: "
- . R X:DTIME E S X="^"
- . I X["^" S OK=-1 Q
- . I X="@" D Q
- . . F I="PATIENT NAME","PATIENT ID","PATIENT BIRTH DATE","PATIENT'S SEX","PATIENT DFN" D
- . . . K ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,I)
- . . . Q
- . . K ^TMP("MAG",$J,"Q/R PARAM","PATIENT LOOKUP MODE") ; reset VistA/Manual Mode
- . . S DFN="",OK=-2
- . . Q
- . I "?"[X D Q
- . . W !!,"Enter either the Patient Name (last,first), the Social Security Number,"
- . . W !,"or the Quick PID (initial + last four). You may use ""@"" to remove it."
- . . Q
- . S X=$TR(X,"-") ; remove dashes in SSN for lookup
- . D PATLKUP(.PATINFO,X)
- . S RETURN=$$PATIENT2("PATIENTS",.PATINFO,"") ; no default (3rd argument)
- . Q
- I OK<0 D
- . S QUIT=1
- . S RETURN=0
- . Q
- Q RETURN
- ;
- PATIENT2(LISTMODE,INFO,DEFAULT) ; called to display a list of patients or a list of PII changes
- ; INFO can be either PATINFO or HISTINFO, same format
- N COUNT
- S COUNT=$G(INFO(0)),DEFAULT=$G(DEFAULT)
- I LISTMODE="PATIENTS" D I 'COUNT Q 0
- . I 'COUNT W " -- NO MATCH"
- . E W " -- ",COUNT," MATCH" W:COUNT>1 "ES"
- . Q
- I COUNT=1 D
- . S RETURN=$$SINGLE(LISTMODE,.INFO,1)
- . Q
- E D
- . S RETURN=$$MULTIPLE(LISTMODE,.INFO,DEFAULT)
- . Q
- Q RETURN
- ;
- SINGLE(LISTMODE,INFO,I) ; single match
- N DATETIME,FIRSTDAY,FIRSTIEN,LASTDAY,LASTIEN,RETURN,STUDYCOUNT
- S DFN=$P(INFO(I),"^",1),SENSITIVE=$P(INFO(I),"^",7)
- W !! D PRINTHDR
- D PRINTPAT(.INFO,I)
- I SENSITIVE D I 'RETURN Q RETURN
- . S RETURN=$$PATCHECK(DFN) Q:'RETURN
- . W !! D PRINTHDR
- . D PRINTPAT(.INFO,I,1)
- . W ?65,"*SENSITIVE*"
- . Q
- I CLIENT="AUTOMATIC" D
- . S RETURN=$$SINGLEA
- . Q
- E D ; CLIENT="MANUAL"
- . S RETURN=$$SINGLEQ
- . Q
- Q RETURN
- ;
- SINGLEA() ; automatic (batch) query retrieve
- ; check for radiology or consults
- I IMAGINGSERVICE="RADIOLOGY" D ; look for radiology reports in the range
- . D RADLKUP^MAGDSTA4(DFN,.STUDYCOUNT,.FIRSTDAY,.LASTDAY,.FIRSTIEN,.LASTIEN)
- . Q
- E D ; look for consults/procedures in the range
- . D CONLKUP^MAGDSTA6(DFN,.STUDYCOUNT,.FIRSTDAY,.LASTDAY,.FIRSTIEN,.LASTIEN)
- . Q
- ;
- I 'STUDYCOUNT S RETURN=0
- E D
- . I $$YESNO^MAGDSTQ("Is this the correct "_PROMPT_"?","n",.X)>0,X="YES" D
- . . S RETURN=I
- . . S ^TMP("MAG",$J,"BATCH Q/R","PATIENT DFN")=$P(INFO(I),"^",1)
- . . S ^TMP("MAG",$J,"BATCH Q/R","BEGIN DATE")=FIRSTDAY
- . . S ^TMP("MAG",$J,"BATCH Q/R","END DATE")=LASTDAY+.235959 ; end of day
- . . S (DONE,FINIS,OK)=1
- . . Q
- . E S RETURN=0
- . Q
- Q RETURN
- ;
- SINGLEQ() ; manual query retrieve
- I $$YESNO^MAGDSTQ("Is this the correct "_PROMPT_"?","n",.X)>0,X="YES" D
- . S RETURN=I
- . S (DONE,FINIS,OK)=1
- . Q
- E S RETURN=0
- Q RETURN
- ;
- PATCHECK(DFN) ; check patient sensitivity
- N NOTICE,SECINFO,PATCHECK,X
- I $D(PATCHECKED(DFN)) Q 1 ; patient already checked
- ;
- I $$VISTA^MAGDSTQ D ; VistA code
- . D PTSEC^DGSEC4(.SECINFO,DFN,1,"^VistA Query/Retrieve Client") ; ICR #3027
- . Q
- E D I SECINFO(1)=-1 D Q 0 ; DICOM Gateway code
- . S X=$$CALLRPC^MAGM2VCU("DG SENSITIVE RECORD ACCESS","M",.SECINFO,DFN,1,"^DICOM Gateway Query/Retrieve Client")
- . I SECINFO(1)=-1 D Q ; RPC failed
- . . D ERRORMSG^MAGDSTQ0(1,"Error in DG SENSITIVE RECORD ACCESS rpc",.SECINFO)
- . . Q
- . Q
- I SECINFO(1) D I 'PATCHECK Q 0
- . N I
- . W ! S I=1 F S I=$O(SECINFO(I)) Q:I="" D
- . . ; write sensitive patient warning message
- . . W !?(IOM-$L(SECINFO(I))/2),SECINFO(I)
- . . Q
- . I SECINFO(1)=1 D CONTINUE^MAGDSTQ S PATCHECK=1 Q
- . I SECINFO(1)'=2 D CONTINUE^MAGDSTQ S PATCHECK=0 Q
- . I $$YESNO^MAGDSTQ("Do you want to continue processing this patient record?","n",.X)<0 S PATCHECK=0 Q
- . I X="NO" S PATCHECK=0 Q
- . I $$VISTA^MAGDSTQ D ; VistA code
- . . D NOTICE^DGSEC4(.NOTICE,DFN,"^VistA Query/Retrieve Client",1) ; ICR #3027
- . . Q
- . E D ; DICOM Gateway code
- . . S X=$$CALLRPC^MAGM2VCU("DG SENSITIVE RECORD BULLETIN","M",.NOTICE,DFN,"^DICOM Gateway Query/Retrieve Client",1)
- . . I 'NOTICE D S PATCHECK=0 Q ; RPC error
- . . . D ERRORMSG^MAGDSTQ0(1,"Error in DG SENSITIVE RECORD BULLETIN rpc",.NOTICE)
- . . . Q
- . . Q
- . S PATCHECK=1
- . Q
- E S PATCHECK=1
- I PATCHECK S PATCHECKED(DFN)=1
- Q PATCHECK
- ;
- MULTIPLE(LISTMODE,INFO,DEFAULT) ; display information for multiple patients/pii changes
- N DONE,RETURN
- S (DONE,RETURN)=0
- I LISTMODE="PATIENTS" W !!,"There are ",COUNT," matches"
- E W !!,"There are changes in the patient identification"
- R "... Press <Enter> for list",X:$G(DTIME,300)
- I COUNT>20 D ; more than twenty patients/pii changes
- . F K=1:20:COUNT S RETURN=$$MULTI(DEFAULT) Q:DONE
- . Q
- E D ; twenty or less patients
- . S K=1 S RETURN=$$MULTI(DEFAULT) Q:DONE
- Q RETURN
- ;
- MULTI(DEFAULT) ; display one set of patients
- N I,K20,FINIS,RETURN
- S RETURN=0
- S K20=K+19 I K20>COUNT S K20=COUNT
- S FINIS=0 F D Q:FINIS
- . W @IOF D PRINTHDR
- . F I=K:1:K20 D
- . . D PRINTPAT(.INFO,I)
- . W !!,"Enter 1-",K20," to select the ",PROMPT
- . I K20<COUNT W ", or <Enter> to see more ",PROMPT,"s"
- . W ": " I DEFAULT'="" W DEFAULT,"// "
- . R I:$G(DTIME,300) E S I="^"
- . I I="" W DEFAULT S I=DEFAULT
- . I I="" S FINIS=1 Q
- . I I["^" S DONE=1,I="",FINIS=-1 Q
- . I I?1N.N,I'<1,I'>K20 S RETURN=$$SINGLE(LISTMODE,.INFO,I) Q
- . W " ???" R X:$G(DTIME,300)
- . Q
- Q RETURN
- ;
- PRINTHDR ; print column header
- W ?4,"Social Sec#",?16,"Sex",?21,"Patient's Name",?53,"Birth Date"
- I $G(LISTMODE)="PII CHANGES" W ?65,"Change Date"
- W !?4,"-----------",?16,"---",?21,"--------------",?53,"----------"
- I $G(LISTMODE)="PII CHANGES" W ?65,"---------------"
- Q
- ;
- PRINTPAT(INFO,I,SENSITIVEOK) ; print patient information
- N X
- D GETINFO(.INFO,I)
- ;
- I '$G(SENSITIVEOK),SENSITIVE D
- . W !,$J(I,2),")",?4,"*SENSITIVE*",?17,$E(SEX,1),?21,$E(NAME,1,30),?53,"*SENSITIVE*"
- . Q
- E D
- . W !,$J(I,2),")",?4,SSN,?17,$E(SEX,1),?21,$E(NAME,1,30),?53,DOB
- . Q
- I $G(LISTMODE)="PII CHANGES" D
- . I CHANGED'="" D
- . . W ?65,CHANGED,?70,"- ",$$CHANGEDT(CHANGEDATE)
- . . Q
- . E W ?72,$$CHANGEDT(CHANGEDATE)
- . Q
- Q
- ;
- SAVEINFO(INFO,DFN,NAME,DOB,PID,SEX,DOD,SENSITIVE,CHANGED,CHANGEDATE) ; save pii
- ; DFN^patient name^DOB^PID^SEX^DOD^Sensitive^Changed Field^Change date & time
- ; 1 2 3 4 5 6 7 8 9
- N X
- I DOB?1"00/00/"4N S DOB=$E(DOB,7,10) ; only year
- S X=DFN_"^"_NAME_"^"_DOB_"^"_PID_"^"_SEX_"^"_$G(DOD)
- S X=X_"^"_$G(SENSITIVE)_"^"_$G(CHANGED)_"^"_$G(CHANGEDATE)
- S INFO(0)=$G(INFO(0))+1
- S INFO(INFO(0))=X
- Q
- ;
- GETINFO(INFO,I) ; retrieve pii
- S X=INFO(I),DFN=$P(X,"^",1),NAME=$P(X,"^",2),DOB=$P(X,"^",3)
- S SSN=$P(X,"^",4),SEX=$P(X,"^",5),DOD=$P(X,"^",6)
- S SENSITIVE=$P(X,"^",7),CHANGED=$P(X,"^",8),CHANGEDATE=$P(X,"^",9)
- Q
- ;
- CHANGEDT(X) ; return change date in mm/dd/yy format
- S X=$$FMTE^XLFDT(X,"5Z")
- Q $E(X,1,6)_$E(X,9,10)
- ;
- PATLKUP(OUTPUT,INPUT) ; patient lookup
- ; INPUT = value to lookup
- ; Lookup uses multiple index lookup of File #2
- ;
- ; OUTPUT = data
- ; OUTPUT(0) = number of records
- ; for i=1:number of records returned:
- ; DFN^patient name^DOB^PID^SEX^DOD^Sensitive
- ; 1 2 3 4 5 6 7
- ;
- ; (DOD = Date of Death)
- ;
- I $$VISTA^MAGDSTQ D ; VistA code - call API
- . D PATLKUP^MAGDSTA3(.OUTPUT,INPUT)
- . Q
- E D ; DICOM Gateway code - call RPC
- . N ARRAY,COUNT,I,RPCERR
- . K OUTPUT
- . S RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM PATIENT LOOKUP","MT",.ARRAY,INPUT)
- . I RPCERR<0 D S OUTPUT(0)=-1 Q
- . . D ERRORMSG^MAGDSTQ0(1,"Error in rpc MAG DICOM PATIENT LOOKUP",.ARRAY)
- . . Q
- . S COUNT=ARRAY(1)
- . F I=0:1:COUNT S OUTPUT(I)=ARRAY(I+1)
- . Q
- Q
- ;
- SCREEN(SCREEN,DFN) ; Screening logic sensitive patients
- ; Input : DFN - Pointer to PATIENT file (#2)
- ; Output : 0 - Don't apply screen
- ; 1 - Apply screen - sensitive patient
- ; 2 - Apply screen - employee
- ; Notes : Screen applied if patient is sensitive or an employee
- ;
- I $$VISTA^MAGDSTQ D ; VistA code - call API
- . D SCREEN^MAGDSTA3(.SCREEN,DFN)
- . Q
- E D ; DICOM Gateway code - call RPC
- . N RPCERR
- . S RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM GET PT SENSITIVITY","M",.SCREEN,DFN)
- . I RPCERR<0 D S SCREEN=-1
- . . D ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM GET PT SENSITIVITY rpc",.SCREEN)
- . . Q
- . Q
- Q
- ;
- ;
- ;
- HISTLKUP(OUTPUT,DFN) ; look up historical patient changes in the audit archive
- ; INPUT = value to lookup
- ; Lookup uses multiple index lookup of File #2
- ;
- ; OUTPUT = data
- ; OUTPUT(0) = number of records
- ; for i=1:number of records returned:
- ; DFN^Patient Name^DOB^PID^SEX^DOD^Sensitive^Changed Field^Change date & time
- ; 1 2 3 4 5 6 7 8 9
- ;
- ; (DOD = Date of Death; DOD and Sensitive are null)
- ;
- I $$VISTA^MAGDSTQ D ; VistA code - call API
- . D HISTLKUP^MAGDSTA3(.OUTPUT,DFN)
- . Q
- E D ; DICOM Gateway code - call RPC
- . N ARRAY,COUNT,I,RPCERR
- . K OUTPUT
- . S RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM PATIENT HISTORY","MT",.ARRAY,DFN)
- . I RPCERR<0 D S OUTPUT(0)=-1 Q
- . . D ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM PATIENT HISTORY rpc",.ARRAY)
- . . Q
- . S COUNT=ARRAY(1)
- . F I=0:1:COUNT S OUTPUT(I)=ARRAY(I+1)
- . Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTQA 12413 printed Feb 18, 2025@23:28:31 Page 2
- 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
- +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 ;
- +18 ; Notice: This routine is on both VistA and the DICOM Gateway
- +19 ;
- +20 ; RPC version of ^MAGDSTA3 on VistA
- +21 ;
- +22 ; Supported IA #3027 reference DG SENSITIVE RECORD ACCESS rpc
- +23 ; Supported IA #3027 reference PTSEC^DGSEC4 subroutine call
- +24 ; Supported IA #3027 reference DG SENSITIVE RECORD BULLETIN rpc
- +25 ; Supported IA #3027 reference NOTICE^DGSEC4 subroutine call
- +26 ; Supported IA #10103 reference $$FMTE^XLFDT function call
- +27 QUIT
- +28 ;
- +29 ; Entry point from ^MAGDSTA1 for automatic (batch) Q/R client
- PATIENTA ; need just DFN for current patient, no previous PII
- +1 NEW CLIENT
- SET CLIENT="AUTOMATIC"
- +2 NEW CHANGED,CHANGEDATE,DFN,DOB,DOD,FINIS,IPATINFO,K,PATINFO,PROMPT
- +3 ;
- +4 ; IPATINFO and PATINFO are not used in this subroutine
- +5 ;
- +6 SET DFN=$GET(^TMP("MAG",$JOB,"BATCH Q/R","PATIENT DFN"))
- +7 SET PROMPT="patient"
- +8 SET IPATINFO=$$PATIENT(.PATINFO,DFN)
- +9 QUIT
- +10 ;
- PATIENT(PATINFO,DFN) ; look up the patients
- +1 NEW DOB,DONE,I,NAME,RETURN,RPCERR,SENSITIVE,SEX,SSN,VA,VADM,VAERR,X
- +2 SET DFN=$GET(DFN)
- SET RETURN=0
- +3 IF DFN'=""
- Begin DoDot:1
- +4 WRITE !!,"The patient is currently defined as follows: "
- +5 ; VistA code - call API
- IF $$VISTA^MAGDSTQ
- Begin DoDot:2
- +6 DO PAT^MAGDRPC1(.VAINFO,DFN)
- +7 QUIT
- End DoDot:2
- +8 ; DICOM Gateway code - call RPC
- IF '$TEST
- Begin DoDot:2
- +9 SET RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM GET PATIENT","M",.VAINFO,DFN)
- +10 IF RPCERR<0
- Begin DoDot:3
- +11 DO ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM GET PATIENT rpc",.VAINFO)
- +12 QUIT
- End DoDot:3
- SET RETURN=-1
- QUIT
- +13 QUIT
- End DoDot:2
- +14 IF RETURN
- QUIT
- +15 DO VADPT^MAGDRPC0(.VAINFO)
- +16 SET VAICN=$GET(VAICN)
- +17 DO SCREEN(.SENSITIVE,DFN)
- +18 SET NAME=VADM(1)
- SET DOB=$PIECE(VADM(3),"^",2)
- SET SSN=$PIECE(VADM(2),"^",2)
- +19 SET SEX=$PIECE(VADM(5),"^",1)
- +20 KILL PATINFO
- +21 DO SAVEINFO(.PATINFO,DFN,NAME,DOB,SSN,SEX,,SENSITIVE)
- +22 WRITE !!
- DO PRINTHDR
- +23 DO PRINTPAT(.PATINFO,1)
- +24 IF $$YESNO^MAGDSTQ("Do you wish to change it?","n",.X)<0
- SET QUIT=1
- QUIT
- +25 IF X="YES"
- Begin DoDot:2
- +26 SET RETURN=$$PATIENT1(.PATINFO)
- +27 QUIT
- End DoDot:2
- +28 ; save info
- IF '$TEST
- Begin DoDot:2
- +29 SET RETURN=1
- End DoDot:2
- +30 QUIT
- End DoDot:1
- +31 IF '$TEST
- Begin DoDot:1
- +32 SET RETURN=$$PATIENT1(.PATINFO)
- +33 QUIT
- End DoDot:1
- +34 QUIT RETURN
- +35 ;
- PATIENT1(PATINFO) ; lookup patient
- +1 NEW I,IN,OK,RETURN,X
- +2 SET OK=0
- FOR
- Begin DoDot:1
- +3 WRITE !!,"Enter Patient: "
- +4 READ X:DTIME
- IF '$TEST
- SET X="^"
- +5 IF X["^"
- SET OK=-1
- QUIT
- +6 IF X="@"
- Begin DoDot:2
- +7 FOR I="PATIENT NAME","PATIENT ID","PATIENT BIRTH DATE","PATIENT'S SEX","PATIENT DFN"
- Begin DoDot:3
- +8 KILL ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,I)
- +9 QUIT
- End DoDot:3
- +10 ; reset VistA/Manual Mode
- KILL ^TMP("MAG",$JOB,"Q/R PARAM","PATIENT LOOKUP MODE")
- +11 SET DFN=""
- SET OK=-2
- +12 QUIT
- End DoDot:2
- QUIT
- +13 IF "?"[X
- Begin DoDot:2
- +14 WRITE !!,"Enter either the Patient Name (last,first), the Social Security Number,"
- +15 WRITE !,"or the Quick PID (initial + last four). You may use ""@"" to remove it."
- +16 QUIT
- End DoDot:2
- QUIT
- +17 ; remove dashes in SSN for lookup
- SET X=$TRANSLATE(X,"-")
- +18 DO PATLKUP(.PATINFO,X)
- +19 ; no default (3rd argument)
- SET RETURN=$$PATIENT2("PATIENTS",.PATINFO,"")
- +20 QUIT
- End DoDot:1
- if OK
- QUIT
- +21 IF OK<0
- Begin DoDot:1
- +22 SET QUIT=1
- +23 SET RETURN=0
- +24 QUIT
- End DoDot:1
- +25 QUIT RETURN
- +26 ;
- 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
- +2 NEW COUNT
- +3 SET COUNT=$GET(INFO(0))
- SET DEFAULT=$GET(DEFAULT)
- +4 IF LISTMODE="PATIENTS"
- Begin DoDot:1
- +5 IF 'COUNT
- WRITE " -- NO MATCH"
- +6 IF '$TEST
- WRITE " -- ",COUNT," MATCH"
- if COUNT>1
- WRITE "ES"
- +7 QUIT
- End DoDot:1
- IF 'COUNT
- QUIT 0
- +8 IF COUNT=1
- Begin DoDot:1
- +9 SET RETURN=$$SINGLE(LISTMODE,.INFO,1)
- +10 QUIT
- End DoDot:1
- +11 IF '$TEST
- Begin DoDot:1
- +12 SET RETURN=$$MULTIPLE(LISTMODE,.INFO,DEFAULT)
- +13 QUIT
- End DoDot:1
- +14 QUIT RETURN
- +15 ;
- SINGLE(LISTMODE,INFO,I) ; single match
- +1 NEW DATETIME,FIRSTDAY,FIRSTIEN,LASTDAY,LASTIEN,RETURN,STUDYCOUNT
- +2 SET DFN=$PIECE(INFO(I),"^",1)
- SET SENSITIVE=$PIECE(INFO(I),"^",7)
- +3 WRITE !!
- DO PRINTHDR
- +4 DO PRINTPAT(.INFO,I)
- +5 IF SENSITIVE
- Begin DoDot:1
- +6 SET RETURN=$$PATCHECK(DFN)
- if 'RETURN
- QUIT
- +7 WRITE !!
- DO PRINTHDR
- +8 DO PRINTPAT(.INFO,I,1)
- +9 WRITE ?65,"*SENSITIVE*"
- +10 QUIT
- End DoDot:1
- IF 'RETURN
- QUIT RETURN
- +11 IF CLIENT="AUTOMATIC"
- Begin DoDot:1
- +12 SET RETURN=$$SINGLEA
- +13 QUIT
- End DoDot:1
- +14 ; CLIENT="MANUAL"
- IF '$TEST
- Begin DoDot:1
- +15 SET RETURN=$$SINGLEQ
- +16 QUIT
- End DoDot:1
- +17 QUIT RETURN
- +18 ;
- SINGLEA() ; automatic (batch) query retrieve
- +1 ; check for radiology or consults
- +2 ; look for radiology reports in the range
- IF IMAGINGSERVICE="RADIOLOGY"
- Begin DoDot:1
- +3 DO RADLKUP^MAGDSTA4(DFN,.STUDYCOUNT,.FIRSTDAY,.LASTDAY,.FIRSTIEN,.LASTIEN)
- +4 QUIT
- End DoDot:1
- +5 ; look for consults/procedures in the range
- IF '$TEST
- Begin DoDot:1
- +6 DO CONLKUP^MAGDSTA6(DFN,.STUDYCOUNT,.FIRSTDAY,.LASTDAY,.FIRSTIEN,.LASTIEN)
- +7 QUIT
- End DoDot:1
- +8 ;
- +9 IF 'STUDYCOUNT
- SET RETURN=0
- +10 IF '$TEST
- Begin DoDot:1
- +11 IF $$YESNO^MAGDSTQ("Is this the correct "_PROMPT_"?","n",.X)>0
- IF X="YES"
- Begin DoDot:2
- +12 SET RETURN=I
- +13 SET ^TMP("MAG",$JOB,"BATCH Q/R","PATIENT DFN")=$PIECE(INFO(I),"^",1)
- +14 SET ^TMP("MAG",$JOB,"BATCH Q/R","BEGIN DATE")=FIRSTDAY
- +15 ; end of day
- SET ^TMP("MAG",$JOB,"BATCH Q/R","END DATE")=LASTDAY+.235959
- +16 SET (DONE,FINIS,OK)=1
- +17 QUIT
- End DoDot:2
- +18 IF '$TEST
- SET RETURN=0
- +19 QUIT
- End DoDot:1
- +20 QUIT RETURN
- +21 ;
- SINGLEQ() ; manual query retrieve
- +1 IF $$YESNO^MAGDSTQ("Is this the correct "_PROMPT_"?","n",.X)>0
- IF X="YES"
- Begin DoDot:1
- +2 SET RETURN=I
- +3 SET (DONE,FINIS,OK)=1
- +4 QUIT
- End DoDot:1
- +5 IF '$TEST
- SET RETURN=0
- +6 QUIT RETURN
- +7 ;
- PATCHECK(DFN) ; check patient sensitivity
- +1 NEW NOTICE,SECINFO,PATCHECK,X
- +2 ; patient already checked
- IF $DATA(PATCHECKED(DFN))
- QUIT 1
- +3 ;
- +4 ; VistA code
- IF $$VISTA^MAGDSTQ
- Begin DoDot:1
- +5 ; ICR #3027
- DO PTSEC^DGSEC4(.SECINFO,DFN,1,"^VistA Query/Retrieve Client")
- +6 QUIT
- End DoDot:1
- +7 ; DICOM Gateway code
- IF '$TEST
- Begin DoDot:1
- +8 SET X=$$CALLRPC^MAGM2VCU("DG SENSITIVE RECORD ACCESS","M",.SECINFO,DFN,1,"^DICOM Gateway Query/Retrieve Client")
- +9 ; RPC failed
- IF SECINFO(1)=-1
- Begin DoDot:2
- +10 DO ERRORMSG^MAGDSTQ0(1,"Error in DG SENSITIVE RECORD ACCESS rpc",.SECINFO)
- +11 QUIT
- End DoDot:2
- QUIT
- +12 QUIT
- End DoDot:1
- IF SECINFO(1)=-1
- Begin DoDot:1
- End DoDot:1
- QUIT 0
- +13 IF SECINFO(1)
- Begin DoDot:1
- +14 NEW I
- +15 WRITE !
- SET I=1
- FOR
- SET I=$ORDER(SECINFO(I))
- if I=""
- QUIT
- Begin DoDot:2
- +16 ; write sensitive patient warning message
- +17 WRITE !?(IOM-$LENGTH(SECINFO(I))/2),SECINFO(I)
- +18 QUIT
- End DoDot:2
- +19 IF SECINFO(1)=1
- DO CONTINUE^MAGDSTQ
- SET PATCHECK=1
- QUIT
- +20 IF SECINFO(1)'=2
- DO CONTINUE^MAGDSTQ
- SET PATCHECK=0
- QUIT
- +21 IF $$YESNO^MAGDSTQ("Do you want to continue processing this patient record?","n",.X)<0
- SET PATCHECK=0
- QUIT
- +22 IF X="NO"
- SET PATCHECK=0
- QUIT
- +23 ; VistA code
- IF $$VISTA^MAGDSTQ
- Begin DoDot:2
- +24 ; ICR #3027
- DO NOTICE^DGSEC4(.NOTICE,DFN,"^VistA Query/Retrieve Client",1)
- +25 QUIT
- End DoDot:2
- +26 ; DICOM Gateway code
- IF '$TEST
- Begin DoDot:2
- +27 SET X=$$CALLRPC^MAGM2VCU("DG SENSITIVE RECORD BULLETIN","M",.NOTICE,DFN,"^DICOM Gateway Query/Retrieve Client",1)
- +28 ; RPC error
- IF 'NOTICE
- Begin DoDot:3
- +29 DO ERRORMSG^MAGDSTQ0(1,"Error in DG SENSITIVE RECORD BULLETIN rpc",.NOTICE)
- +30 QUIT
- End DoDot:3
- SET PATCHECK=0
- QUIT
- +31 QUIT
- End DoDot:2
- +32 SET PATCHECK=1
- +33 QUIT
- End DoDot:1
- IF 'PATCHECK
- QUIT 0
- +34 IF '$TEST
- SET PATCHECK=1
- +35 IF PATCHECK
- SET PATCHECKED(DFN)=1
- +36 QUIT PATCHECK
- +37 ;
- MULTIPLE(LISTMODE,INFO,DEFAULT) ; display information for multiple patients/pii changes
- +1 NEW DONE,RETURN
- +2 SET (DONE,RETURN)=0
- +3 IF LISTMODE="PATIENTS"
- WRITE !!,"There are ",COUNT," matches"
- +4 IF '$TEST
- WRITE !!,"There are changes in the patient identification"
- +5 READ "... Press <Enter> for list",X:$GET(DTIME,300)
- +6 ; more than twenty patients/pii changes
- IF COUNT>20
- Begin DoDot:1
- +7 FOR K=1:20:COUNT
- SET RETURN=$$MULTI(DEFAULT)
- if DONE
- QUIT
- +8 QUIT
- End DoDot:1
- +9 ; twenty or less patients
- IF '$TEST
- Begin DoDot:1
- +10 SET K=1
- SET RETURN=$$MULTI(DEFAULT)
- if DONE
- QUIT
- End DoDot:1
- +11 QUIT RETURN
- +12 ;
- MULTI(DEFAULT) ; display one set of patients
- +1 NEW I,K20,FINIS,RETURN
- +2 SET RETURN=0
- +3 SET K20=K+19
- IF K20>COUNT
- SET K20=COUNT
- +4 SET FINIS=0
- FOR
- Begin DoDot:1
- +5 WRITE @IOF
- DO PRINTHDR
- +6 FOR I=K:1:K20
- Begin DoDot:2
- +7 DO PRINTPAT(.INFO,I)
- End DoDot:2
- +8 WRITE !!,"Enter 1-",K20," to select the ",PROMPT
- +9 IF K20<COUNT
- WRITE ", or <Enter> to see more ",PROMPT,"s"
- +10 WRITE ": "
- IF DEFAULT'=""
- WRITE DEFAULT,"// "
- +11 READ I:$GET(DTIME,300)
- IF '$TEST
- SET I="^"
- +12 IF I=""
- WRITE DEFAULT
- SET I=DEFAULT
- +13 IF I=""
- SET FINIS=1
- QUIT
- +14 IF I["^"
- SET DONE=1
- SET I=""
- SET FINIS=-1
- QUIT
- +15 IF I?1N.N
- IF I'<1
- IF I'>K20
- SET RETURN=$$SINGLE(LISTMODE,.INFO,I)
- QUIT
- +16 WRITE " ???"
- READ X:$GET(DTIME,300)
- +17 QUIT
- End DoDot:1
- if FINIS
- QUIT
- +18 QUIT RETURN
- +19 ;
- PRINTHDR ; print column header
- +1 WRITE ?4,"Social Sec#",?16,"Sex",?21,"Patient's Name",?53,"Birth Date"
- +2 IF $GET(LISTMODE)="PII CHANGES"
- WRITE ?65,"Change Date"
- +3 WRITE !?4,"-----------",?16,"---",?21,"--------------",?53,"----------"
- +4 IF $GET(LISTMODE)="PII CHANGES"
- WRITE ?65,"---------------"
- +5 QUIT
- +6 ;
- PRINTPAT(INFO,I,SENSITIVEOK) ; print patient information
- +1 NEW X
- +2 DO GETINFO(.INFO,I)
- +3 ;
- +4 IF '$GET(SENSITIVEOK)
- IF SENSITIVE
- Begin DoDot:1
- +5 WRITE !,$JUSTIFY(I,2),")",?4,"*SENSITIVE*",?17,$EXTRACT(SEX,1),?21,$EXTRACT(NAME,1,30),?53,"*SENSITIVE*"
- +6 QUIT
- End DoDot:1
- +7 IF '$TEST
- Begin DoDot:1
- +8 WRITE !,$JUSTIFY(I,2),")",?4,SSN,?17,$EXTRACT(SEX,1),?21,$EXTRACT(NAME,1,30),?53,DOB
- +9 QUIT
- End DoDot:1
- +10 IF $GET(LISTMODE)="PII CHANGES"
- Begin DoDot:1
- +11 IF CHANGED'=""
- Begin DoDot:2
- +12 WRITE ?65,CHANGED,?70,"- ",$$CHANGEDT(CHANGEDATE)
- +13 QUIT
- End DoDot:2
- +14 IF '$TEST
- WRITE ?72,$$CHANGEDT(CHANGEDATE)
- +15 QUIT
- End DoDot:1
- +16 QUIT
- +17 ;
- 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
- +2 ; 1 2 3 4 5 6 7 8 9
- +3 NEW X
- +4 ; only year
- IF DOB?1"00/00/"4N
- SET DOB=$EXTRACT(DOB,7,10)
- +5 SET X=DFN_"^"_NAME_"^"_DOB_"^"_PID_"^"_SEX_"^"_$GET(DOD)
- +6 SET X=X_"^"_$GET(SENSITIVE)_"^"_$GET(CHANGED)_"^"_$GET(CHANGEDATE)
- +7 SET INFO(0)=$GET(INFO(0))+1
- +8 SET INFO(INFO(0))=X
- +9 QUIT
- +10 ;
- GETINFO(INFO,I) ; retrieve pii
- +1 SET X=INFO(I)
- SET DFN=$PIECE(X,"^",1)
- SET NAME=$PIECE(X,"^",2)
- SET DOB=$PIECE(X,"^",3)
- +2 SET SSN=$PIECE(X,"^",4)
- SET SEX=$PIECE(X,"^",5)
- SET DOD=$PIECE(X,"^",6)
- +3 SET SENSITIVE=$PIECE(X,"^",7)
- SET CHANGED=$PIECE(X,"^",8)
- SET CHANGEDATE=$PIECE(X,"^",9)
- +4 QUIT
- +5 ;
- CHANGEDT(X) ; return change date in mm/dd/yy format
- +1 SET X=$$FMTE^XLFDT(X,"5Z")
- +2 QUIT $EXTRACT(X,1,6)_$EXTRACT(X,9,10)
- +3 ;
- PATLKUP(OUTPUT,INPUT) ; patient lookup
- +1 ; INPUT = value to lookup
- +2 ; Lookup uses multiple index lookup of File #2
- +3 ;
- +4 ; OUTPUT = data
- +5 ; OUTPUT(0) = number of records
- +6 ; for i=1:number of records returned:
- +7 ; DFN^patient name^DOB^PID^SEX^DOD^Sensitive
- +8 ; 1 2 3 4 5 6 7
- +9 ;
- +10 ; (DOD = Date of Death)
- +11 ;
- +12 ; VistA code - call API
- IF $$VISTA^MAGDSTQ
- Begin DoDot:1
- +13 DO PATLKUP^MAGDSTA3(.OUTPUT,INPUT)
- +14 QUIT
- End DoDot:1
- +15 ; DICOM Gateway code - call RPC
- IF '$TEST
- Begin DoDot:1
- +16 NEW ARRAY,COUNT,I,RPCERR
- +17 KILL OUTPUT
- +18 SET RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM PATIENT LOOKUP","MT",.ARRAY,INPUT)
- +19 IF RPCERR<0
- Begin DoDot:2
- +20 DO ERRORMSG^MAGDSTQ0(1,"Error in rpc MAG DICOM PATIENT LOOKUP",.ARRAY)
- +21 QUIT
- End DoDot:2
- SET OUTPUT(0)=-1
- QUIT
- +22 SET COUNT=ARRAY(1)
- +23 FOR I=0:1:COUNT
- SET OUTPUT(I)=ARRAY(I+1)
- +24 QUIT
- End DoDot:1
- +25 QUIT
- +26 ;
- SCREEN(SCREEN,DFN) ; Screening logic sensitive patients
- +1 ; Input : DFN - Pointer to PATIENT file (#2)
- +2 ; Output : 0 - Don't apply screen
- +3 ; 1 - Apply screen - sensitive patient
- +4 ; 2 - Apply screen - employee
- +5 ; Notes : Screen applied if patient is sensitive or an employee
- +6 ;
- +7 ; VistA code - call API
- IF $$VISTA^MAGDSTQ
- Begin DoDot:1
- +8 DO SCREEN^MAGDSTA3(.SCREEN,DFN)
- +9 QUIT
- End DoDot:1
- +10 ; DICOM Gateway code - call RPC
- IF '$TEST
- Begin DoDot:1
- +11 NEW RPCERR
- +12 SET RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM GET PT SENSITIVITY","M",.SCREEN,DFN)
- +13 IF RPCERR<0
- Begin DoDot:2
- +14 DO ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM GET PT SENSITIVITY rpc",.SCREEN)
- +15 QUIT
- End DoDot:2
- SET SCREEN=-1
- +16 QUIT
- End DoDot:1
- +17 QUIT
- +18 ;
- +19 ;
- +20 ;
- HISTLKUP(OUTPUT,DFN) ; look up historical patient changes in the audit archive
- +1 ; INPUT = value to lookup
- +2 ; Lookup uses multiple index lookup of File #2
- +3 ;
- +4 ; OUTPUT = data
- +5 ; OUTPUT(0) = number of records
- +6 ; for i=1:number of records returned:
- +7 ; DFN^Patient Name^DOB^PID^SEX^DOD^Sensitive^Changed Field^Change date & time
- +8 ; 1 2 3 4 5 6 7 8 9
- +9 ;
- +10 ; (DOD = Date of Death; DOD and Sensitive are null)
- +11 ;
- +12 ; VistA code - call API
- IF $$VISTA^MAGDSTQ
- Begin DoDot:1
- +13 DO HISTLKUP^MAGDSTA3(.OUTPUT,DFN)
- +14 QUIT
- End DoDot:1
- +15 ; DICOM Gateway code - call RPC
- IF '$TEST
- Begin DoDot:1
- +16 NEW ARRAY,COUNT,I,RPCERR
- +17 KILL OUTPUT
- +18 SET RPCERR=$$CALLRPC^MAGM2VCU("MAG DICOM PATIENT HISTORY","MT",.ARRAY,DFN)
- +19 IF RPCERR<0
- Begin DoDot:2
- +20 DO ERRORMSG^MAGDSTQ0(1,"Error in MAG DICOM PATIENT HISTORY rpc",.ARRAY)
- +21 QUIT
- End DoDot:2
- SET OUTPUT(0)=-1
- QUIT
- +22 SET COUNT=ARRAY(1)
- +23 FOR I=0:1:COUNT
- SET OUTPUT(I)=ARRAY(I+1)
- +24 QUIT
- End DoDot:1
- +25 QUIT