| 1 | MAGCRPT ;WOIFO/EdM ; Report on inconsistencies ; [ 11/01/2001 11:27 ]
|
|---|
| 2 | ;;3.0;IMAGING;;Mar 01, 2002
|
|---|
| 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 | ;; | |
|
|---|
| 11 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 12 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 13 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 14 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 15 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 16 | ;; +---------------------------------------------------------------+
|
|---|
| 17 | ;;
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | RPT(TYPE) ; This entry is called from the VistA Menu Option handler
|
|---|
| 21 | ; The value of TYPE is equal to either
|
|---|
| 22 | ; "QA" -- report for Quality Assurance (option MAG_IC_RPT_QA)
|
|---|
| 23 | ; "CO" -- report for Central Office (option MAG_IC_RPT_CO)
|
|---|
| 24 | ;
|
|---|
| 25 | N OK,POP,X,Y,STOP,TODAY,STATUS,NUMBER,ERRTYPE,I,II,VA,VADM
|
|---|
| 26 | S NUMBER=$O(^XTMP("MAGCHK",""))
|
|---|
| 27 | I +NUMBER,$P(^XTMP("MAGCHK",NUMBER,0),"^",1)'?.N1".".N S NUMBER=0
|
|---|
| 28 | ; Previous scans had the 1st piece as the scan status instead of the purge date for XTMP
|
|---|
| 29 | S OUT=0
|
|---|
| 30 | I +NUMBER D
|
|---|
| 31 | . S STATUS=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",4)
|
|---|
| 32 | . D NOW^%DTC S TODAY=%
|
|---|
| 33 | . S START=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",5)
|
|---|
| 34 | . S STOP=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",6)
|
|---|
| 35 | I +NUMBER I STATUS'="COMPLETE" D
|
|---|
| 36 | . S Y=$P(^XTMP("MAGCHK",NUMBER,0),"^",5) X ^DD("DD")
|
|---|
| 37 | . N DIR
|
|---|
| 38 | . S OK=1
|
|---|
| 39 | . W !!,"Scanning appears to be active. It was started on: "_Y
|
|---|
| 40 | . S DIR(0)="Y",DIR("B")="Y"
|
|---|
| 41 | . S DIR("A")="Do you want to start it again?"
|
|---|
| 42 | . D ^DIR S:'Y OK=0
|
|---|
| 43 | . I 'OK W !,"Note: Report will be partial and not the complete report."
|
|---|
| 44 | . I OK S NUMBER=0
|
|---|
| 45 | . I Y["^" S OUT=1
|
|---|
| 46 | . Q
|
|---|
| 47 | I +OUT Q
|
|---|
| 48 | ;check to see if scan is over 2 weeks old
|
|---|
| 49 | I +NUMBER I STATUS="COMPLETE" S X1=TODAY,X2=STOP D ^%DTC I X>14 D
|
|---|
| 50 | . S DAYS=+X
|
|---|
| 51 | . N DIR
|
|---|
| 52 | . S OK=1
|
|---|
| 53 | . S DIR(0)="Y",DIR("B")="Y"
|
|---|
| 54 | . S DIR("A",1)="The database scanner has not run in "_+X_" days"
|
|---|
| 55 | . S DIR("A")="Do you want to start a new scan? "
|
|---|
| 56 | . D ^DIR S:'Y OK=0
|
|---|
| 57 | . I 'OK W !,"Note: You will get an old report."
|
|---|
| 58 | . I OK S NUMBER=0
|
|---|
| 59 | . I Y["^" S OUT=1
|
|---|
| 60 | . Q
|
|---|
| 61 | I +OUT Q
|
|---|
| 62 | S OK=0 F D Q:POP>0 Q:OK
|
|---|
| 63 | . D ^%ZIS Q:POP>0
|
|---|
| 64 | . I IOM<132 W !!,"Report is formatted for 132 columns",!,"Try again" Q
|
|---|
| 65 | . S OK=1
|
|---|
| 66 | . I $E(IOST,1,1)'="P" D Q:'OK
|
|---|
| 67 | . . N DIR
|
|---|
| 68 | . . S DIR(0)="Y"
|
|---|
| 69 | . . S DIR("A")="This is not a printer. Is this OK",DIR("B")="YES"
|
|---|
| 70 | . . D ^DIR S:'Y OK=0
|
|---|
| 71 | . . Q
|
|---|
| 72 | . I $D(IO("Q")) D Q
|
|---|
| 73 | . . S ZTRTN="WORK^MAGICRPT"
|
|---|
| 74 | . . S ZTIO=ION_";132"
|
|---|
| 75 | . . S ZTDESC="Imaging Integrity Check Report"
|
|---|
| 76 | . . S ZTSAVE("TYPE")=TYPE
|
|---|
| 77 | . . D ^%ZTLOAD,HOME^%ZIS
|
|---|
| 78 | . . I '$D(ZTSK) S OK=0 W !!,$C(7),"Request canceled.",! Q
|
|---|
| 79 | . . W !!,"Request queued." S OK=-1
|
|---|
| 80 | . . Q
|
|---|
| 81 | . Q
|
|---|
| 82 | Q:OK<1 Q:POP>0
|
|---|
| 83 | W !!,"Report being produced on ",IOST,!!
|
|---|
| 84 | U IO D WORK D ^%ZISC,HOME^%ZIS
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | WORK N D0,ERR,H1,H2,I,LIN,N,PAG,PT,SQI,X
|
|---|
| 88 | K ^TMP("MAGMAIL",$J)
|
|---|
| 89 | S ^TMP("MAGMAIL",$J,1,0)="Image^DFN-1^Name-1^SS4-1^SS4-2^DFN-2^DFN-2^Package^D0/D1^Message"
|
|---|
| 90 | D:'NUMBER RPT^MAGGSQI(.SQI,1E11) S NUMBER=$O(^XTMP("MAGCHK",""))
|
|---|
| 91 | S H1=$P(^XTMP("MAGCHK",NUMBER,0),"^",5) S X=H1 D H^%DTC S H1=%H_","_%T
|
|---|
| 92 | S H2=$P(^XTMP("MAGCHK",NUMBER,0),"^",6) S X=H2 D H^%DTC S H2=%H_","_%T
|
|---|
| 93 | S PAG=0
|
|---|
| 94 | S PT(3.9)="^XMB(3.9,PD0|MailMan||2|^XMB(3.9,PD0,2005,"
|
|---|
| 95 | S PT(63)="^LR(PD0,GF,PD1|Aut (M)|AY|1|^LR(PD0,GF,PD1,2005,"
|
|---|
| 96 | S PT(63.02)="^LR(PD0,GF,PD1|El-Micr|EM|1|^LR(PD0,GF,PD1,2005,"
|
|---|
| 97 | S PT(63.08)="^LR(PD0,GF,PD1|SrgPath|SP|1|^LR(PD0,GF,PD1,2005,"
|
|---|
| 98 | S PT(63.09)="^LR(PD0,GF,PD1|Cytol|CY|1|^LR(PD0,GF,PD1,2005,"
|
|---|
| 99 | S PT(63.2)="^LR(PD0,GF,PD1|Aut (G)|AU|1|^LR(PD0,GF,PD1,2005,"
|
|---|
| 100 | S PT(74)="^RARPT(PD0|Rad||2|^RARPT(PD0,2005,"
|
|---|
| 101 | S PT(130)="^SRF(PD0|Surgery||1|^SRF(PD0,2005,"
|
|---|
| 102 | S PT(691)="^MCAR(691,PD0|Echo||2|^MCAR(691,PD0,2005,"
|
|---|
| 103 | S PT(691.1)="^MCAR(691.1,PD0|Cath||2|^MCAR(691.1,PD0,2005,"
|
|---|
| 104 | S PT(691.5)="^MCAR(691.5,PD0|ECG||2|^MCAR(691.5,PD0,2005,"
|
|---|
| 105 | S PT(694)="^MCAR(694,PD0|Hema||2|^MCAR(694,PD0,2005,"
|
|---|
| 106 | S PT(699)="^MCAR(699,PD0|Endo||2|^MCAR(699,PD0,2005,"
|
|---|
| 107 | S PT(699.5)="^MCAR(699.5,PD0|Med||2|^MCAR(699.5,PD0,2005,"
|
|---|
| 108 | ;S PT(8925)="^TIU(8925,PD0|TIU||2|^TIU(8925.91,""ADI"",PD0,"
|
|---|
| 109 | S PT(8925)="^TIU(8925,PD0|TIU||2|^TIU(8925.91,""ADI"",PD0,"
|
|---|
| 110 | S ERR="" F S ERR=$O(^XTMP("MAGCHK",NUMBER,"B",ERR)) Q:ERR="" D
|
|---|
| 111 | . I TYPE="CO" S X=1 D Q:X
|
|---|
| 112 | . . S:ERR="Patient pointer mismatch between Image Group and Image" X=0
|
|---|
| 113 | . . S:ERR="Image and associated report have different patient pointers" X=0
|
|---|
| 114 | . . S:ERR="Associated report does not point back to Image" X=0
|
|---|
| 115 | . . Q
|
|---|
| 116 | . S ERRTYPE(ERR)=0 I ERR="Images only point to Patient." K ERRTYPE(ERR) Q
|
|---|
| 117 | . D HDR(ERR)
|
|---|
| 118 | . S N=0
|
|---|
| 119 | . S D0="" F S D0=$O(^XTMP("MAGCHK",NUMBER,"B",ERR,D0)) Q:D0="" D
|
|---|
| 120 | . . N ASITE,DFN,IDFN,IPN,ISS4,PD0,PD1,PDFN,PF,PK,PPN,PSS4,X0,X2
|
|---|
| 121 | . . S N=N+1
|
|---|
| 122 | . . S ASITE=$P($G(^MAG(2005,D0,100)),"^",3)
|
|---|
| 123 | . . S X0=$G(^MAG(2005,D0,0))
|
|---|
| 124 | . . S X2=$G(^MAG(2005,D0,2))
|
|---|
| 125 | . . S IDFN=$P(X0,"^",7) S:'IDFN IDFN="-?-"
|
|---|
| 126 | . . S PF=$P(X2,"^",6),PD0=$P(X2,"^",7),PD1=$P(X2,"^",10)
|
|---|
| 127 | . . S X=$G(PT(+PF),"|Unknown")
|
|---|
| 128 | . . S PK=$P(X,"|",2)
|
|---|
| 129 | . . ;S DFN=IDFN D DEM^VADPT S IPN=VADM(1),ISS4=$E(IPN,1)_$G(VA("BID"))
|
|---|
| 130 | . . S XX=+$$PTLKP(IDFN,.IPN,.ISS4)
|
|---|
| 131 | . . S (PPN,PDFN,PSS4)=""
|
|---|
| 132 | . . D:ERR="Image and associated report have different patient pointers"
|
|---|
| 133 | . . . N GF,GP,GR,GR0,GT,P0,T
|
|---|
| 134 | . . . Q:PK="Unknown"
|
|---|
| 135 | . . . S GR=$P(PT(PF),"|",1),GR0=GR_",0)"
|
|---|
| 136 | . . . S GP=$P(PT(PF),"|",4)
|
|---|
| 137 | . . . S P0=$G(@GR0,"^not defined"),PDFN=$P(P0,"^",GP)
|
|---|
| 138 | . . . I PF\1=63 S PDFN=PD0
|
|---|
| 139 | . . . I 'PDFN,IPN=PDFN S PDFN=IDFN
|
|---|
| 140 | . . . Q:IDFN=PDFN
|
|---|
| 141 | . . . S XX=+$$PTLKP(PDFN,.PPN,.PSS4)
|
|---|
| 142 | . . . ;S DFN=PDFN D DEM^VADPT S PPN=VADM(1),PSS4=$E(PPN,1)_$G(VA("BID"))
|
|---|
| 143 | . . . Q
|
|---|
| 144 | . . D:ERR="Patient pointer mismatch between Image Group and Image"
|
|---|
| 145 | . . . N G0,P0
|
|---|
| 146 | . . . S P0=$P(X0,"^",10)
|
|---|
| 147 | . . . S X0=$G(^MAG(2005,D0,0))
|
|---|
| 148 | . . . S X2=$G(^MAG(2005,D0,2))
|
|---|
| 149 | . . . S PDFN=$P(X0,"^",7) D:IDFN=PDFN
|
|---|
| 150 | . . . . S G0=0 F S G0=$O(^MAG(2005,P0,1,G0)) Q:'G0 D Q:'G0
|
|---|
| 151 | . . . . . S X0=$G(^MAG(2005,+$P($G(^MAG(2005,P0,1,G0,0)),"^",1),0))
|
|---|
| 152 | . . . . . S PDFN=$P(X0,"^",7) S:PDFN'=IDFN G0=0
|
|---|
| 153 | . . . . . Q
|
|---|
| 154 | . . . . Q
|
|---|
| 155 | . . . Q:PDFN=IDFN
|
|---|
| 156 | . . . S XX=+$$PTLKP(PDFN,.PPN,.PSS4)
|
|---|
| 157 | . . . ;S DFN=PDFN D DEM^VADPT S PPN=VADM(1),PSS4=$E(PPN,1)_$G(VA("BID"))
|
|---|
| 158 | . . . Q
|
|---|
| 159 | . . S LIN=LIN+1 D:LIN>IOSL HDR(ERR)
|
|---|
| 160 | . . S X=PD0 S:PD1 X=X_"/"_PD1
|
|---|
| 161 | . . I TYPE="CO",PK'="Rad" Q
|
|---|
| 162 | . . Q:ERR="Images only point to Patient."
|
|---|
| 163 | . . S ERRTYPE(ERR)=$G(ERRTYPE(ERR))+1
|
|---|
| 164 | . . W !,$J(D0,7)," ",$$L(IPN,31)," ",$$L(PPN,31)," "
|
|---|
| 165 | . . W $$L(ISS4,5)," ",$$L(PSS4,5)," "
|
|---|
| 166 | . . W $J(IDFN,8)," ",$J(PDFN,8)," ",$$L(PK,8)," ",$J(X,5)," ",$J(ASITE,5)
|
|---|
| 167 | . . S I=$O(^TMP("MAGMAIL",$J," "),-1)+1
|
|---|
| 168 | . . S ^TMP("MAGMAIL",$J,I,0)=D0_"^"_IPN_"^"_PPN_"^"_ISS4_"^"_PSS4_"^"_IDFN_"^"_PDFN_"^"_PK_"^"_X_"^"_ERR_"^"_ASITE
|
|---|
| 169 | . . Q
|
|---|
| 170 | . Q
|
|---|
| 171 | ;
|
|---|
| 172 | D PN
|
|---|
| 173 | W !,"S u m m a r y"
|
|---|
| 174 | ;S X=$G(SQI(0)) W !!,+X," ",$P(X,"^",2),!!
|
|---|
| 175 | S X=$P($G(^XTMP("MAGCHK",NUMBER,0)),"^",8) W !!,X," entries scanned."
|
|---|
| 176 | S II=$O(^TMP("MAGMAIL",$J," "),-1)+1
|
|---|
| 177 | S ^TMP("MAGMAIL",$J,II,0)=+X_" entries scanned."
|
|---|
| 178 | S I="" F S I=$O(ERRTYPE(I)) Q:I="" D
|
|---|
| 179 | . W !,$J($G(ERRTYPE(I)),7)," occurrence" W:+$G(ERRTYPE(I))'=1 "s" W " of ",I
|
|---|
| 180 | . S II=$O(^TMP("MAGMAIL",$J," "),-1)+1
|
|---|
| 181 | . S ^TMP("MAGMAIL",$J,II,0)=$G(ERRTYPE(I))_" occurrence"_$S($G(ERRTYPE(I))'=1:"s",1:"")_" of "_I
|
|---|
| 182 | . Q
|
|---|
| 183 | I +H1 D
|
|---|
| 184 | . S X=$P(H2,",",1)-$P(H1,",",1)*86400+$P(H2,",",2)-$P(H1,",",2)
|
|---|
| 185 | . W !!,"Database scan took "
|
|---|
| 186 | . S HRS=X\3600 I +HRS S HRS=+HRS_$S(HRS>1:" hours ",1:" hour ") W HRS
|
|---|
| 187 | . S MIN=X\60#60 I +MIN S MIN=+MIN_$S(MIN>1:" minutes ",1:" minute ") W MIN
|
|---|
| 188 | . S SEC=X#60 I +SEC S SEC=+SEC_$S(SEC>1:" seconds ",1:" second ") W SEC
|
|---|
| 189 | . S II=$O(^TMP("MAGMAIL",$J," "),-1)+1
|
|---|
| 190 | . S ^TMP("MAGMAIL",$J,II,0)="Database scan took "_HRS_" "_MIN_" "_SEC
|
|---|
| 191 | . Q
|
|---|
| 192 | N XMY,XMTEXT,XMSUB
|
|---|
| 193 | S XMY("G.MAG SERVER")=""
|
|---|
| 194 | S XMTEXT="^TMP(""MAGMAIL"","_$J_","
|
|---|
| 195 | S XMSUB="Imaging Integrity Check ("_TYPE_")"
|
|---|
| 196 | ;
|
|---|
| 197 | I TYPE="CO" I $P(^XTMP("MAGCHK",NUMBER,0),"^",7)="" D
|
|---|
| 198 | . D ^XMD
|
|---|
| 199 | . S $P(^XTMP("MAGCHK",NUMBER,0),"^",7)="MAILED"
|
|---|
| 200 | . Q
|
|---|
| 201 | ;
|
|---|
| 202 | I TYPE="QA" I $P(^XTMP("MAGCHK",NUMBER,0),"^",9)="" D
|
|---|
| 203 | . D ^XMD
|
|---|
| 204 | . S $P(^XTMP("MAGCHK",NUMBER,0),"^",9)="MAILED"
|
|---|
| 205 | . Q
|
|---|
| 206 | K ^TMP("MAGMAIL",$J)
|
|---|
| 207 | Q
|
|---|
| 208 | ;
|
|---|
| 209 | L(X,N) Q $E(X_$J("",N),1,N)
|
|---|
| 210 | ;
|
|---|
| 211 | PTLKP(DFN,IPN,ISS4) ;
|
|---|
| 212 | S IPN="Unknown"
|
|---|
| 213 | S ISS4="Unk"
|
|---|
| 214 | I DFN="" Q "0^NO_DFN"
|
|---|
| 215 | D DEM^VADPT
|
|---|
| 216 | S:'VAERR IPN=VADM(1),ISS4=$E(IPN,1)_$G(VA("BID"))
|
|---|
| 217 | I 'VAERR Q "1^SUCCESS"
|
|---|
| 218 | Q "0^FAILED"
|
|---|
| 219 | ;
|
|---|
| 220 | PN N X
|
|---|
| 221 | S PAG=PAG+1,X="Page "_PAG,LIN=6
|
|---|
| 222 | W:PAG'=1 @IOF
|
|---|
| 223 | W DT#100," "
|
|---|
| 224 | W $P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",DT\100#100)
|
|---|
| 225 | W " ",DT\10000+1700,?(IOM-$L(X)),X
|
|---|
| 226 | Q
|
|---|
| 227 | ;
|
|---|
| 228 | HDR(ERR) ;
|
|---|
| 229 | D PN
|
|---|
| 230 | S HEADING=$S(TYPE="CO":"**** Report on Inconsistencies Caused by Global Moves ****",1:"**** Report of All Image-Related Inconsistencies Detected ****")
|
|---|
| 231 | W !?(IOM-$L(HEADING)\2),HEADING
|
|---|
| 232 | W !?(IOM-$L(ERR)\2),ERR,!
|
|---|
| 233 | W !,"Image Patient Name Patient Name SSN4 SSN4 DFN DFN Package"
|
|---|
| 234 | W !,"Number (First one found) (Other one found) (fst) (oth) (fst) (oth) Package IEN SITE"
|
|---|
| 235 | W !,"======= =============================== =============================== ===== ===== ======== ======== ======= ======= ====="
|
|---|
| 236 | W !
|
|---|
| 237 | Q
|
|---|
| 238 | ;
|
|---|
| 239 | QA ; Report for QA
|
|---|
| 240 | D RPT("QA")
|
|---|
| 241 | Q
|
|---|
| 242 | ;
|
|---|
| 243 | CO ; Report for CO
|
|---|
| 244 | D RPT("CO")
|
|---|
| 245 | Q
|
|---|
| 246 | ;
|
|---|
| 247 | TEST S IOSL=55,IOM=132,IO=$P,TYPE="QA" D WORK
|
|---|
| 248 | Q
|
|---|
| 249 | ;
|
|---|
| 250 | DOCU ;
|
|---|
| 251 | ;^XTMP("MAGCHK",$J,0)=PURGE DATE^CREATE DATE^DESCRIPTION^STATUS^SCAN START^SCAN STOP^C0 MAILED^#SCANNED^QA MAILED
|
|---|
| 252 | Q
|
|---|
