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

MAGVCLN1.m

Go to the documentation of this file. 
  1. MAGVCLN1 ;WOIFO/DAC - File 2005.6X Duplicate Removal Utility ; Feb 22, 2022@21:12:01
  1.  ;;3.0;IMAGING;**278**;Mar 19, 2002;Build 138
  1.  ;; Per VA Directive 6402, 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. MSG(DELETE,MAGQ) ; Display intro message
  1.  N DIR,DELOPT,IDOPT,Y
  1.  S DELOPT="Resolve HDIG Problem Records [MAGV RESOLVE PROBLEMS]"
  1.  S IDOPT="Search For HDIG Problem Records [MAGV SEARCH PROBLEMS]"
  1.  W !!
  1.  S DIR("A",1)="This option will "_$S($G(DELETE):"set as INACCESSIBLE",1:"identify")_" records from 2005.6x Imaging files that"
  1.  S DIR("A",2)="meet either of the following conditions:"
  1.  S DIR("A",3)=""
  1.  S DIR("A",4)="  1) Duplicate records containing the same key field (.01) value."
  1.  S DIR("A",5)="  2) Records with a missing or invalid pointer to its parent record."
  1.  S DIR("A",6)=""
  1.  S DIR("A",7)="The "_$S($G(DELETE):"records marked INACCESSIBLE",1:"identified records")_" will be displayed to the selected output device,"
  1.  S DIR("A",8)="and also captured in the NEW IMAGING FILE CLEANUP LOG file (#2005.67)."
  1.  S DIR("A",9)=""
  1.  S DIR("A",10)="To "_$S($G(DELETE):"identify the records without modifying them, please use the option",1:"mark records INACCESSIBLE after they've been identified, please use option")
  1.  S DIR("A",11)=$S($G(DELETE):IDOPT,1:DELOPT)_"."
  1.  S DIR("A",12)=""
  1.  S DIR("A")="Would you like to continue "_$S($G(DELETE):"marking the problem records INACCESSIBLE",1:"identifying the problem records")
  1.  S DIR("B")="N",DIR(0)="Y" D ^DIR
  1.  S MAGQ=$S($G(Y):0,1:1)
  1.  Q
  1.  ;
  1. DEVICE(DELETE,MAGQUIT,MAGQUE,MAGSCR) ; Request Device Information
  1.  N %ZIS,IOP,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP,RTN,VAR
  1.  K IO("Q")
  1.  S %ZIS="QM"
  1.  S (MAGQUE,MAGQUIT)=0
  1.  W ! D ^%ZIS
  1.  I POP S MAGQUIT=1 Q
  1.  S MAGSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
  1.  I $D(IO("Q")) D  S MAGQUE=1
  1.  . S RTN=$P($T(+1)," ",1)
  1.  . S ZTRTN="IDDEL^"_RTN_"(DELETE)"
  1.  . S ZTIO=ION
  1.  . S ZTSAVE("MAG**")=""
  1.  . S ZTSAVE("DELETE")=""
  1.  . S ZTDESC="IMAGING DATABASE CLEANUP"
  1.  . D ^%ZTLOAD
  1.  . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
  1.  . D HOME^%ZIS
  1.  U IO
  1.  Q
  1. CONT ; Continue
  1.  W ! K DIR("A") S DIR(0)="E" D ^DIR K DIR
  1.  Q
  1.  ;
  1. GETP(FILE,IEN) ; Get Patient Reference from File entry
  1.  N PTR1,PTR2
  1.  I '$G(FILE)!'$G(IEN) Q ""
  1.  I FILE=2005.6 Q $P($G(^MAGV(2005.6,+IEN,0)),"^")
  1.  I FILE=2005.61 Q $$GETP61(IEN)
  1.  I FILE=2005.62 Q $$GETP62(IEN)
  1.  I FILE=2005.63 Q $$GETP63(IEN)
  1.  I FILE=2005.64 Q $$GETP64(IEN)
  1.  I FILE=2005.65 Q $$GETP65(IEN)
  1.  Q ""
  1.  ;
  1. GETP61(IEN) ;  Get Patient Reference from file 2005.61
  1.  N PTR6
  1.  S PTR6=$P($G(^MAGV(2005.61,+$G(IEN),6)),"^")
  1.  Q $P($G(^MAGV(2005.6,+PTR6,0)),"^")
  1.  ;
  1. GETP62(IEN) ;  Get Patient Reference from file 2005.62
  1.  N PTR6
  1.  S PTR6=$P($G(^MAGV(2005.62,+$G(IEN),6)),"^",3)
  1.  Q:PTR6=""!(PTR6'=+PTR6) ""
  1.  Q $P($G(^MAGV(2005.6,PTR6,0)),"^")
  1.  ;
  1. GETP63(IEN) ; Get Patient Reference from file 2005.63
  1.  N PTR62
  1.  S PTR62=$P($G(^MAGV(2005.63,+$G(IEN),6)),"^")
  1.  Q $$GETP62(PTR62)
  1.  ;
  1. GETP64(IEN) ; Get Patient Reference from file 2005.64
  1.  N PTR63
  1.  S PTR63=$P($G(^MAGV(2005.64,+$G(IEN),6)),"^")
  1.  Q $$GETP63(PTR63)
  1.  ;
  1. GETP65(IEN) ; Get Patient Reference from file 2005.64
  1.  N PTR64
  1.  S PTR64=$P($G(^MAGV(2005.65,+$G(IEN),6)),"^")
  1.  Q $$GETP64(PTR64)
  1.  ;
  1. TMPMSG(DELETE)  ; Send MailMan LOG REPORT
  1.  N XMSUB,XMDUZ,MAGXMD,XMY
  1.  S MAGXMD="MAGVCLN"
  1.  S XMSUB=$S($G(DELETE):"Resolve",1:"Search")_" Imaging Problem Records "_$$FMTE^XLFDT(DT,"5DZ"),XMDUZ=$S($G(DUZ):DUZ,1:.5)
  1.  S XMY(XMDUZ)="",XMY("G.MAG SERVER")=""
  1.  N DIFROM S XMTEXT="^TMP("""_MAGXMD_""","_$J_"," D ^XMD K DIFROM
  1.  K XMTEXT
  1.  Q
  1.  ;
  1. MSGHDR(MAGLICNT,DELETE) ; Output header for Mailman - when run silently (as in post-install)
  1.  S ^TMP("MAGVCLN",$J,+$G(MAGLICNT))="            MAGV "_$S($G(DELETE):"RESOLVE PROBLEM RECORDS",1:"SEARCH FOR PROBLEM RECORDS"),MAGLICNT=MAGLICNT+1
  1.  S ^TMP("MAGVCLN",$J,MAGLICNT)="   Problem records in files 2005.6x "_$S($G(DELETE):"resolved ",1:"identified ")_"by the MAG*3.0*278",MAGLICNT=MAGLICNT+1
  1.  S ^TMP("MAGVCLN",$J,MAGLICNT)="   post-installation process are displayed below.",MAGLICNT=MAGLICNT+1
  1.  S ^TMP("MAGVCLN",$J,MAGLICNT)="",MAGLICNT=MAGLICNT+1
  1.  S ^TMP("MAGVCLN",$J,MAGLICNT)="Non-Primary "
  1.  Q
  1.  ;
  1. OUTPUT(TEXT,MAGBLF,MAGALF,MAGPOST) ; Output a line of TEXT
  1.  ; TEXT= Line of text
  1.  ; MAGBLF = Number of 'before' line feeds
  1.  ; MAGALF = Number of 'after' line feeds
  1.  ; MAGPOST = Called as post-install routine, output mailed to DUZ
  1.  ;
  1.  N MAGMAXLF,MAGDONE,MAGCNT
  1.  S MAGDONE=0,MAGCNT=0
  1.  S MAGMAXLF=10  ; Max number of line feeds
  1.  I $G(MAGBLF)>0 D
  1.  . F MAGCNT=1:1:MAGBLF Q:$G(MAGDONE)  D
  1.  . . I MAGCNT>MAGMAXLF S MAGDONE=1 Q
  1.  . . I '$G(MAGPOST) W !
  1.  . . I $G(MAGPOST) S ^TMP("MAGVCLN",$J,+$G(MAGLICNT))="",MAGLICNT=$G(MAGLICNT)+1
  1.  I '$G(MAGPOST) W !,TEXT
  1.  I $G(MAGPOST) S ^TMP("MAGVCLN",$J,+$G(MAGLICNT))=TEXT,MAGLICNT=$G(MAGLICNT)+1
  1.  S MAGDONE=0
  1.  I $G(MAGALF)>0 D
  1.  . F MAGCNT=1:1:MAGBLF Q:$G(MAGDONE)  D
  1.  . . I MAGCNT>MAGMAXLF S MAGDONE=1 Q
  1.  . . I '$G(MAGPOST) W !
  1.  . . I $G(MAGPOST) S ^TMP("MAGVCLN",$J,+$G(MAGLICNT))="",MAGLICNT=$G(MAGLICNT)+1
  1.  ;
  1.  Q
  1. AUDIT(KEY,FILE,IEN,ORIGIEN,REASON,ACTION,DELIEN,ORIGAOF,DUPEIEN) ; Audit File for Problem Records?
  1.  N MAGFDA,MAGMSG,LOGIEN,LOGFIEN
  1.  Q:KEY=""
  1.  Q:IEN=""
  1.  S ACTION=$S($G(ACTION)="MI":"MI",$G(ACTION)="MC":"MC",$G(ACTION):"SI",1:"I")
  1.  ;
  1.  K MAGFDA,MAGMSG
  1.  S MAGFDA(2005.67,"+1,",.01)=IEN
  1.  S MAGFDA(2005.67,"+1,",1)=FILE
  1.  S MAGFDA(2005.67,"+1,",2)=$G(ORIGIEN)
  1.  S MAGFDA(2005.67,"+1,",3)=REASON
  1.  S MAGFDA(2005.67,"+1,",4)=ACTION
  1.  S MAGFDA(2005.67,"+1,",5)=$$NOW^XLFDT
  1.  S MAGFDA(2005.67,"+1,",6)=KEY
  1.  I $L($G(DELIEN)) S MAGFDA(2005.67,"+1,",7)=$G(DELIEN)
  1.  I $L($G(ORIGAOF)) S MAGFDA(2005.67,"+1,",8)=ORIGAOF
  1.  I $L($G(ORIGAOF)) S MAGFDA(2005.67,"+1,",9)=DUPEIEN
  1.  ;
  1.  ; Reason Codes:
  1.  ; 1 - Duplicate
  1.  ; 2 - No Parent Record Pointer
  1.  ; 3 - Invalid Parent Record Pointer
  1.  ; 4 - No Patient Ref Pointer
  1.  ; 5 - Invalid Patient Ref Pointer
  1.  ; 6 - Duplicate Parent Reference
  1.  ;
  1.  D UPDATE^DIE("","MAGFDA","","MAGMSG")
  1.  K MAGFDA
  1.  Q
  1.  ;
  1. PATNAME(FILE,IEN) ; Get patient name from 2005.6x file
  1.  N PATIEN,PATNAME,MAGPATID,MAGPATIEN
  1.  I FILE'["2005.6" Q "UNKNOWN"
  1.  S MAGPATID=$$GETP^MAGVCLN1(FILE,IEN)
  1.  I 'MAGPATID Q "UNKNOWN"
  1.  S MAGPATIEN=$O(^MAGV(2005.6,"B",MAGPATID,0))
  1.  I 'MAGPATIEN Q "UNKNOWN"
  1.  S PATNAME=$$GET1^DIQ(2005.6,MAGPATIEN_",",3)
  1.  S:'$L(PATNAME) PATNAME="UNKNOWN"
  1.  Q PATNAME
  1.  ;
  1. PATMAGID(FILE,IEN) ; Get ENTERPRISE PATIENT ID file (#2005.6) ID 
  1.  N PATIEN,PATNAME,MAGPATID,MAGPATIEN
  1.  I FILE'["2005.6" Q "UNKNOWN"
  1.  S MAGPATID=$$GETP^MAGVCLN1(FILE,IEN)
  1.  I 'MAGPATID Q "UNKNOWN"
  1.  Q MAGPATID