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

MAGCRPT.m

Go to the documentation of this file. 
  1. MAGCRPT ;WOIFO/EdM ; Report on inconsistencies ; [ 11/01/2001 11:27 ]
  1.  ;;3.0;IMAGING;;Mar 01, 2002
  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.  ;; |                                                               |
  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. RPT(TYPE) ; This entry is called from the VistA Menu Option handler
  1.  ; The value of TYPE is equal to either
  1.  ;  "QA"  -- report for Quality Assurance  (option MAG_IC_RPT_QA)
  1.  ;  "CO"  -- report for Central Office     (option MAG_IC_RPT_CO)
  1.  ;
  1.  N OK,POP,X,Y,STOP,TODAY,STATUS,NUMBER,ERRTYPE,I,II,VA,VADM
  1.  S NUMBER=$O(^XTMP("MAGCHK",""))
  1.  I +NUMBER,$P(^XTMP("MAGCHK",NUMBER,0),"^",1)'?.N1".".N S NUMBER=0
  1.  ; Previous scans had the 1st piece as the scan status instead of the purge date for XTMP
  1.  S OUT=0
  1.  I +NUMBER D
  1.  . S STATUS=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",4)
  1.  . D NOW^%DTC S TODAY=%
  1.  . S START=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",5)
  1.  . S STOP=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",6)
  1.  I +NUMBER I STATUS'="COMPLETE" D
  1.  . S Y=$P(^XTMP("MAGCHK",NUMBER,0),"^",5) X ^DD("DD")
  1.  . N DIR
  1.  . S OK=1
  1.  . W !!,"Scanning appears to be active.  It was started on: "_Y
  1.  . S DIR(0)="Y",DIR("B")="Y"
  1.  . S DIR("A")="Do you want to start it again?"
  1.  . D ^DIR S:'Y OK=0
  1.  . I 'OK W !,"Note:  Report will be partial and not the complete report."
  1.  . I OK S NUMBER=0
  1.  . I Y["^" S OUT=1
  1.  . Q
  1.  I +OUT Q
  1.  ;check to see if scan is over 2 weeks old
  1.  I +NUMBER I STATUS="COMPLETE" S X1=TODAY,X2=STOP D ^%DTC I X>14 D
  1.  . S DAYS=+X
  1.  . N DIR
  1.  . S OK=1
  1.  . S DIR(0)="Y",DIR("B")="Y"
  1.  . S DIR("A",1)="The database scanner has not run in "_+X_" days"
  1.  . S DIR("A")="Do you want to start a new scan? "
  1.  . D ^DIR S:'Y OK=0
  1.  . I 'OK W !,"Note:  You will get an old report."
  1.  . I OK S NUMBER=0
  1.  . I Y["^" S OUT=1
  1.  . Q
  1.  I +OUT Q
  1.  S OK=0 F  D  Q:POP>0  Q:OK
  1.  . D ^%ZIS Q:POP>0
  1.  . I IOM<132 W !!,"Report is formatted for 132 columns",!,"Try again" Q
  1.  . S OK=1
  1.  . I $E(IOST,1,1)'="P" D  Q:'OK
  1.  . . N DIR
  1.  . . S DIR(0)="Y"
  1.  . . S DIR("A")="This is not a printer.  Is this OK",DIR("B")="YES"
  1.  . . D ^DIR S:'Y OK=0
  1.  . . Q
  1.  . I $D(IO("Q")) D  Q
  1.  . . S ZTRTN="WORK^MAGICRPT"
  1.  . . S ZTIO=ION_";132"
  1.  . . S ZTDESC="Imaging Integrity Check Report"
  1.  . . S ZTSAVE("TYPE")=TYPE
  1.  . . D ^%ZTLOAD,HOME^%ZIS
  1.  . . I '$D(ZTSK) S OK=0 W !!,$C(7),"Request canceled.",! Q
  1.  . . W !!,"Request queued." S OK=-1
  1.  . . Q
  1.  . Q
  1.  Q:OK<1  Q:POP>0
  1.  W !!,"Report being produced on ",IOST,!!
  1.  U IO D WORK D ^%ZISC,HOME^%ZIS
  1.  Q
  1.  ;
  1. WORK N D0,ERR,H1,H2,I,LIN,N,PAG,PT,SQI,X
  1.  K ^TMP("MAGMAIL",$J)
  1.  S ^TMP("MAGMAIL",$J,1,0)="Image^DFN-1^Name-1^SS4-1^SS4-2^DFN-2^DFN-2^Package^D0/D1^Message"
  1.  D:'NUMBER RPT^MAGGSQI(.SQI,1E11) S NUMBER=$O(^XTMP("MAGCHK",""))
  1.  S H1=$P(^XTMP("MAGCHK",NUMBER,0),"^",5) S X=H1 D H^%DTC S H1=%H_","_%T
  1.  S H2=$P(^XTMP("MAGCHK",NUMBER,0),"^",6) S X=H2 D H^%DTC S H2=%H_","_%T
  1.  S PAG=0
  1.  S PT(3.9)="^XMB(3.9,PD0|MailMan||2|^XMB(3.9,PD0,2005,"
  1.  S PT(63)="^LR(PD0,GF,PD1|Aut (M)|AY|1|^LR(PD0,GF,PD1,2005,"
  1.  S PT(63.02)="^LR(PD0,GF,PD1|El-Micr|EM|1|^LR(PD0,GF,PD1,2005,"
  1.  S PT(63.08)="^LR(PD0,GF,PD1|SrgPath|SP|1|^LR(PD0,GF,PD1,2005,"
  1.  S PT(63.09)="^LR(PD0,GF,PD1|Cytol|CY|1|^LR(PD0,GF,PD1,2005,"
  1.  S PT(63.2)="^LR(PD0,GF,PD1|Aut (G)|AU|1|^LR(PD0,GF,PD1,2005,"
  1.  S PT(74)="^RARPT(PD0|Rad||2|^RARPT(PD0,2005,"
  1.  S PT(130)="^SRF(PD0|Surgery||1|^SRF(PD0,2005,"
  1.  S PT(691)="^MCAR(691,PD0|Echo||2|^MCAR(691,PD0,2005,"
  1.  S PT(691.1)="^MCAR(691.1,PD0|Cath||2|^MCAR(691.1,PD0,2005,"
  1.  S PT(691.5)="^MCAR(691.5,PD0|ECG||2|^MCAR(691.5,PD0,2005,"
  1.  S PT(694)="^MCAR(694,PD0|Hema||2|^MCAR(694,PD0,2005,"
  1.  S PT(699)="^MCAR(699,PD0|Endo||2|^MCAR(699,PD0,2005,"
  1.  S PT(699.5)="^MCAR(699.5,PD0|Med||2|^MCAR(699.5,PD0,2005,"
  1.  ;S PT(8925)="^TIU(8925,PD0|TIU||2|^TIU(8925.91,""ADI"",PD0,"
  1.  S PT(8925)="^TIU(8925,PD0|TIU||2|^TIU(8925.91,""ADI"",PD0,"
  1.  S ERR="" F  S ERR=$O(^XTMP("MAGCHK",NUMBER,"B",ERR)) Q:ERR=""  D 
  1.  . I TYPE="CO" S X=1 D  Q:X
  1.  . . S:ERR="Patient pointer mismatch between Image Group and Image" X=0
  1.  . . S:ERR="Image and associated report have different patient pointers" X=0
  1.  . . S:ERR="Associated report does not point back to Image" X=0
  1.  . . Q
  1.  . S ERRTYPE(ERR)=0 I ERR="Images only point to Patient." K ERRTYPE(ERR) Q
  1.  . D HDR(ERR)
  1.  . S N=0
  1.  . S D0="" F  S D0=$O(^XTMP("MAGCHK",NUMBER,"B",ERR,D0)) Q:D0=""  D
  1.  . . N ASITE,DFN,IDFN,IPN,ISS4,PD0,PD1,PDFN,PF,PK,PPN,PSS4,X0,X2
  1.  . . S N=N+1
  1.  . . S ASITE=$P($G(^MAG(2005,D0,100)),"^",3)
  1.  . . S X0=$G(^MAG(2005,D0,0))
  1.  . . S X2=$G(^MAG(2005,D0,2))
  1.  . . S IDFN=$P(X0,"^",7) S:'IDFN IDFN="-?-"
  1.  . . S PF=$P(X2,"^",6),PD0=$P(X2,"^",7),PD1=$P(X2,"^",10)
  1.  . . S X=$G(PT(+PF),"|Unknown")
  1.  . . S PK=$P(X,"|",2)
  1.  . . ;S DFN=IDFN D DEM^VADPT S IPN=VADM(1),ISS4=$E(IPN,1)_$G(VA("BID"))
  1.  . . S XX=+$$PTLKP(IDFN,.IPN,.ISS4)
  1.  . . S (PPN,PDFN,PSS4)=""
  1.  . . D:ERR="Image and associated report have different patient pointers"
  1.  . . . N GF,GP,GR,GR0,GT,P0,T
  1.  . . . Q:PK="Unknown"
  1.  . . . S GR=$P(PT(PF),"|",1),GR0=GR_",0)"
  1.  . . . S GP=$P(PT(PF),"|",4)
  1.  . . . S P0=$G(@GR0,"^not defined"),PDFN=$P(P0,"^",GP)
  1.  . . . I PF\1=63 S PDFN=PD0
  1.  . . . I 'PDFN,IPN=PDFN S PDFN=IDFN
  1.  . . . Q:IDFN=PDFN
  1.  . . . S XX=+$$PTLKP(PDFN,.PPN,.PSS4)
  1.  . . . ;S DFN=PDFN D DEM^VADPT S PPN=VADM(1),PSS4=$E(PPN,1)_$G(VA("BID"))
  1.  . . . Q
  1.  . . D:ERR="Patient pointer mismatch between Image Group and Image"
  1.  . . . N G0,P0
  1.  . . . S P0=$P(X0,"^",10)
  1.  . . . S X0=$G(^MAG(2005,D0,0))
  1.  . . . S X2=$G(^MAG(2005,D0,2))
  1.  . . . S PDFN=$P(X0,"^",7) D:IDFN=PDFN
  1.  . . . . S G0=0 F  S G0=$O(^MAG(2005,P0,1,G0)) Q:'G0  D  Q:'G0
  1.  . . . . . S X0=$G(^MAG(2005,+$P($G(^MAG(2005,P0,1,G0,0)),"^",1),0))
  1.  . . . . . S PDFN=$P(X0,"^",7) S:PDFN'=IDFN G0=0
  1.  . . . . . Q
  1.  . . . . Q
  1.  . . . Q:PDFN=IDFN
  1.  . . . S XX=+$$PTLKP(PDFN,.PPN,.PSS4)
  1.  . . . ;S DFN=PDFN D DEM^VADPT S PPN=VADM(1),PSS4=$E(PPN,1)_$G(VA("BID"))
  1.  . . . Q
  1.  . . S LIN=LIN+1 D:LIN>IOSL HDR(ERR)
  1.  . . S X=PD0 S:PD1 X=X_"/"_PD1
  1.  . . I TYPE="CO",PK'="Rad" Q
  1.  . . Q:ERR="Images only point to Patient."
  1.  . . S ERRTYPE(ERR)=$G(ERRTYPE(ERR))+1
  1.  . . W !,$J(D0,7),"  ",$$L(IPN,31),"  ",$$L(PPN,31),"  "
  1.  . . W $$L(ISS4,5),"  ",$$L(PSS4,5),"  "
  1.  . . W $J(IDFN,8),"  ",$J(PDFN,8),"  ",$$L(PK,8),"  ",$J(X,5)," ",$J(ASITE,5)
  1.  . . S I=$O(^TMP("MAGMAIL",$J," "),-1)+1
  1.  . . S ^TMP("MAGMAIL",$J,I,0)=D0_"^"_IPN_"^"_PPN_"^"_ISS4_"^"_PSS4_"^"_IDFN_"^"_PDFN_"^"_PK_"^"_X_"^"_ERR_"^"_ASITE
  1.  . . Q
  1.  . Q
  1.  ;
  1.  D PN
  1.  W !,"S u m m a r y"
  1.  ;S X=$G(SQI(0)) W !!,+X," ",$P(X,"^",2),!!
  1.  S X=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",8) W !!,X," entries scanned."
  1.  S II=$O(^TMP("MAGMAIL",$J," "),-1)+1
  1.  S ^TMP("MAGMAIL",$J,II,0)=+X_" entries scanned."
  1.  S I="" F  S I=$O(ERRTYPE(I)) Q:I=""  D
  1.  . W !,$J($G(ERRTYPE(I)),7)," occurrence" W:+$G(ERRTYPE(I))'=1 "s" W " of ",I
  1.  . S II=$O(^TMP("MAGMAIL",$J," "),-1)+1
  1.  . S ^TMP("MAGMAIL",$J,II,0)=$G(ERRTYPE(I))_" occurrence"_$S($G(ERRTYPE(I))'=1:"s",1:"")_" of "_I
  1.  . Q
  1.  I +H1 D
  1.  . S X=$P(H2,",",1)-$P(H1,",",1)*86400+$P(H2,",",2)-$P(H1,",",2)
  1.  . W !!,"Database scan took "
  1.  . S HRS=X\3600 I +HRS S HRS=+HRS_$S(HRS>1:" hours ",1:" hour ") W HRS
  1.  . S MIN=X\60#60 I +MIN S MIN=+MIN_$S(MIN>1:" minutes ",1:" minute ") W MIN
  1.  . S SEC=X#60 I +SEC S SEC=+SEC_$S(SEC>1:" seconds ",1:" second ") W SEC
  1.  . S II=$O(^TMP("MAGMAIL",$J," "),-1)+1
  1.  . S ^TMP("MAGMAIL",$J,II,0)="Database scan took "_HRS_" "_MIN_" "_SEC
  1.  . Q
  1.  N XMY,XMTEXT,XMSUB
  1.  S XMY("G.MAG SERVER")=""
  1.  S XMTEXT="^TMP(""MAGMAIL"","_$J_","
  1.  S XMSUB="Imaging Integrity Check ("_TYPE_")"
  1.  ;
  1.  I TYPE="CO" I $P(^XTMP("MAGCHK",NUMBER,0),"^",7)="" D
  1.  . D ^XMD
  1.  . S $P(^XTMP("MAGCHK",NUMBER,0),"^",7)="MAILED"
  1.  . Q
  1.  ;
  1.  I TYPE="QA" I $P(^XTMP("MAGCHK",NUMBER,0),"^",9)="" D
  1.  . D ^XMD
  1.  . S $P(^XTMP("MAGCHK",NUMBER,0),"^",9)="MAILED"
  1.  . Q
  1.  K ^TMP("MAGMAIL",$J)
  1.  Q
  1.  ;
  1. L(X,N) Q $E(X_$J("",N),1,N)
  1.  ;
  1. PTLKP(DFN,IPN,ISS4) ;
  1.  S IPN="Unknown"
  1.  S ISS4="Unk"
  1.  I DFN="" Q "0^NO_DFN"
  1.  D DEM^VADPT
  1.  S:'VAERR IPN=VADM(1),ISS4=$E(IPN,1)_$G(VA("BID"))
  1.  I 'VAERR Q "1^SUCCESS"
  1.  Q "0^FAILED"
  1.  ;
  1. PN N X
  1.  S PAG=PAG+1,X="Page "_PAG,LIN=6
  1.  W:PAG'=1 @IOF
  1.  W DT#100," "
  1.  W $P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",DT\100#100)
  1.  W " ",DT\10000+1700,?(IOM-$L(X)),X
  1.  Q
  1.  ;
  1. HDR(ERR) ;
  1.  D PN
  1.  S HEADING=$S(TYPE="CO":"**** Report on Inconsistencies Caused by Global Moves ****",1:"**** Report of All Image-Related Inconsistencies Detected ****")
  1.  W !?(IOM-$L(HEADING)\2),HEADING
  1.  W !?(IOM-$L(ERR)\2),ERR,!
  1.  W !,"Image    Patient Name                     Patient Name                     SSN4   SSN4    DFN      DFN                Package"
  1.  W !,"Number   (First one found)                (Other one found)                (fst)  (oth)  (fst)     (oth)     Package  IEN      SITE"
  1.  W !,"=======  ===============================  ===============================  =====  =====  ========  ========  =======  ======= ====="
  1.  W !
  1.  Q
  1.  ;
  1. QA ; Report for QA
  1.  D RPT("QA")
  1.  Q
  1.  ;
  1. CO ; Report for CO
  1.  D RPT("CO")
  1.  Q
  1.  ;
  1. TEST S IOSL=55,IOM=132,IO=$P,TYPE="QA" D WORK
  1.  Q
  1.  ;
  1. DOCU ;
  1.  ;^XTMP("MAGCHK",$J,0)=PURGE DATE^CREATE DATE^DESCRIPTION^STATUS^SCAN START^SCAN STOP^C0 MAILED^#SCANNED^QA MAILED
  1.  Q