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