ACHSXREF ; IHS/ITSC/PMF - UNDOCUMENTED X-REF FIX FOR CHS FACILITY FILE [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
S U="^"
S $ZT="ERROR^"_$ZN
S %H=$H D YX^%DTC S NOW=Y
I $G(ACHSVERS)="" S ACHSVERS="V3.1T1"
;
S ^ACHSINST(ACHSVERS,$ZN,"ENTERED")=NOW
;
S ACHSYAYA="" F S ACHSYAYA=$O(^ACHSXREF(ACHSYAYA)) Q:ACHSYAYA="" K ^(ACHSYAYA) ;RESET GLOBAL COUNTER
K ACHSYAYA
;
D EOBD
D EOBP
D EOBR
D ES
D PB
D TB
D VB
D AC
;
;OKAY NOW LETS SEE IF ANY DANGLING XREFS FOUND ARE NOT IN THE
;SAVED FILE
;D COMPARE ;WILL NOT BE OF USE UNLESS 'ARCHIVE' FILE IS STILL AROUND
D CLEANUP
;
S %H=$H D YX^%DTC S NOW=Y
S ^ACHSINST(ACHSVERS,$ZN,"FINISHED")=NOW
;
Q
;
EOBD ;
S XREF="EOBD"
S TOTALMIS=0
S FACILITY=0
W !!,"CHECKING EOBD X-REFS...."
W !,"CROSS REFERENCE BY FUNKY DATE, DOCUMENT IEN, TRANSACTION IEN"
F S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0 D
.S FUNKYDT=0
.F S FUNKYDT=$O(^ACHSF(FACILITY,"EOBD",FUNKYDT)) Q:+FUNKYDT=0 D
..S DOCNUM=0
..F S DOCNUM=$O(^ACHSF(FACILITY,"EOBD",FUNKYDT,DOCNUM)) Q:+DOCNUM=0 D
...S TRANNUM=0
...F S TRANNUM=$O(^ACHSF(FACILITY,"EOBD",FUNKYDT,DOCNUM,TRANNUM)) Q:+TRANNUM=0 D
....D DOCSUM,TRANSUM
...I KILLIT K ^ACHSF(FACILITY,"EOBD",FUNKYDT,DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_FUNKYDT_","_DOCNUM_")"
;
W !,"TOTAL MISSING: ",TOTALMIS
Q
;
;
EOBP ;
S XREF="EOBP"
S TOTALMIS=0
S FACILITY=0
W !!,"CHECKING EOBP X-REFS...."
W !,"CROSS REFERENCE BY PATEINT DFN , DOCUMENT IEN, TRANSACTION IEN"
F S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0 D
.S PATNUM=0
.F S PATNUM=$O(^ACHSF(FACILITY,"EOBP",PATNUM)) Q:+PATNUM=0 D
..S DOCNUM=0
..F S DOCNUM=$O(^ACHSF(FACILITY,"EOBP",PATNUM,DOCNUM)) Q:+DOCNUM=0 D
...S TRANNUM=0
...F S TRANNUM=$O(^ACHSF(FACILITY,"EOBP",PATNUM,DOCNUM,TRANNUM)) Q:+TRANNUM=0 D
....D DOCSUM,TRANSUM
...I KILLIT K ^ACHSF(FACILITY,"EOBP",PATNUM,DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_PATNUM_","_DOCNUM_")"
;
W !,"TOTAL MISSING: ",TOTALMIS
Q
;
EOBR ;
S XREF="EOBR"
W !!,"CHECKING EOBR X-REFS....."
W !,"CROSS REFERENCE BY DOCUMENT IEN, TRANSACTION IEN, FUNKYDATE"
S TOTALMIS=0
S FACILITY=0
F S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0 D
.S DOCNUM=0
.F S DOCNUM=$O(^ACHSF(FACILITY,"EOBR",DOCNUM)) Q:+DOCNUM=0 D
..S TRANNUM=0
..F S TRANNUM=$O(^ACHSF(FACILITY,"EOBR",DOCNUM,TRANNUM)) Q:+TRANNUM=0 D
...D DOCSUM,TRANSUM
..I KILLIT K ^ACHSF(FACILITY,"EOBR",DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_DOCNUM_")"
;
W !,"TOTAL MISSING: ",TOTALMIS
Q
;
ES ;
S XREF="ES"
S TOTALMIS=0
S FACILITY=0
W !!,"CHECKING ES X-REFS...."
W !,"CROSS REFERENCE BY FUNKY DATE , DOCUMENT IEN"
F S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0 D
.S FUNKYDT=0
.F S FUNKYDT=$O(^ACHSF(FACILITY,"ES",FUNKYDT)) Q:+FUNKYDT=0 D
..S DOCNUM=0
..F S DOCNUM=$O(^ACHSF(FACILITY,"ES",FUNKYDT,DOCNUM)) Q:+DOCNUM=0 D
...D DOCSUM
...I KILLIT K ^ACHSF(FACILITY,"ES",FUNKYDT,DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_FUNKYDT_","_DOCNUM_")"
;
W !,"TOTAL MISSING: ",TOTALMIS
Q
;
PB ;
S XREF="PB"
W !!,"CHECKING PB X-REFS....."
W !,"CROSS REFERENCE BY PATIENT DFN, DOCUMENT IEN, TRANSACTION IEN"
S TOTALMIS=0
S FACILITY=0
F S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0 D
.S DFN=0
.F S DFN=$O(^ACHSF(FACILITY,"PB",DFN)) Q:+DFN=0 D
..S DOCNUM=0
..F S DOCNUM=$O(^ACHSF(FACILITY,"PB",DFN,DOCNUM)) Q:+DOCNUM=0 D
...S TRANNUM=0
...F S TRANNUM=$O(^ACHSF(FACILITY,"PB",DFN,DOCNUM,TRANNUM)) Q:+TRANNUM=0 D
....D DOCSUM,TRANSUM
....I KILLIT K ^ACHSF(FACILITY,"PB",DFN,DOCNUM,TRANNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_DFN_","_DOCNUM_")"
;
W !,"TOTAL MISSING: ",TOTALMIS
Q
;
TB ;
S XREF="TB"
W !!,"CHECKING TB X-REFS....."
W !,"CROSS REFERENCE BY DATE, TRANSACTION TYPE, DOCUMENT IEN, TRANSACTION IEN"
S TOTALMIS=0
S FACILITY=0
F S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0 D
.S DATE=0
.F S DATE=$O(^ACHSF(FACILITY,"TB",DATE)) Q:+DATE=0 D
..S TRANTYPE=""
..F S TRANTYPE=$O(^ACHSF(FACILITY,"TB",DATE,TRANTYPE)) Q:TRANTYPE="" D
...S DOCNUM=0
...F S DOCNUM=$O(^ACHSF(FACILITY,"TB",DATE,TRANTYPE,DOCNUM)) Q:+DOCNUM=0 D
....S TRANNUM=0
....F S TRANNUM=$O(^ACHSF(FACILITY,"TB",DATE,TRANTYPE,DOCNUM,TRANNUM)) Q:+TRANNUM=0 D
.....D DOCSUM,TRANSUM
...I KILLIT K ^ACHSF(FACILITY,"TB",DATE,TRANTYPE,DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_DATE_","_TRANTYPE_","_DOCNUM_")"
;
W !,"TOTAL MISSING: ",TOTALMIS
Q
;
VB ;
S XREF="VB"
W !!,"CHECKING VB X-REF....."
W !,"CROSS REFERENCE BY PROVIDER IEN, DOCUMENT IEN, TRANSACTION IEN"
S TOTALMIS=0
S FACILITY=0
F S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0 D
.S PROVNUM=0
.F S PROVNUM=$O(^ACHSF(FACILITY,"VB",PROVNUM)) Q:+PROVNUM=0 D
..S DOCNUM=0
..F S DOCNUM=$O(^ACHSF(FACILITY,"VB",PROVNUM,DOCNUM)) Q:+DOCNUM=0 D
...S TRANNUM=0
...F S TRANNUM=$O(^ACHSF(FACILITY,"VB",PROVNUM,DOCNUM,TRANNUM)) Q:+TRANNUM=0 D
....D DOCSUM,TRANSUM
...I KILLIT K ^ACHSF(FACILITY,"VB",PROVNUM,DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_PROVNUM_","_DOCNUM_")"
;
W !,"TOTAL MISSING: ",TOTALMIS
Q
;
AC ;
S XREF="AC"
W !!,"CHECKING AC X-REF...."
W !,"CROSS REFERENCE BY PROVIDER IEN, DOCUMENT IEN, TRANSACTION IEN"
S TOTALMIS=0
S PATNUM=0
F S PATNUM=$O(^ACHSF("AC",PATNUM)) Q:+PATNUM=0 D
.S FACILITY=0
.F S FACILITY=$O(^ACHSF("AC",PATNUM,FACILITY)) Q:+FACILITY=0 D
..S DOCNUM=0
..F S DOCNUM=$O(^ACHSF("AC",PATNUM,FACILITY,DOCNUM)) Q:+DOCNUM=0 D
...S TRANNUM=0
...F S TRANNUM=$O(^ACHSF("AC",PATNUM,FACILITY,DOCNUM,TRANNUM)) Q:+TRANNUM=0 D
....D DOCSUM,TRANSUM
....I KILLIT K ^ACHSF("AC",PATNUM,FACILITY,DOCNUM) W !,"KILLING ^ACHSF("_XREF_","_PATNUM_","_FACILITY_","_DOCNUM_")"
W !,"TOTAL MISSING: ",TOTALMIS
Q
;
DOCSUM ;
S KILLIT=0
Q:$D(^ACHSF(FACILITY,"D",DOCNUM,0))
S TOTALMIS=TOTALMIS+1
S ^ACHSXREF(FACILITY,DOCNUM,XREF)=$G(^ACHSXREF(FACILITY,DOCNUM,XREF))+1
;W !!,"FAC: ",FACILITY
;W !,"DOC: ",DOCNUM
D DOCALL(FACILITY,DOCNUM) ;CHECK FOR INFO IN OTHER DOCUMENT NODES
I 'BARE W !,"DATA WAS FOUND IN OTHER NODES FOR DOCUMENT "_DOCNUM_" IN FACILITY "_FACILITY_" . INVESTIGATION NEEDED!" Q
;
;IF WE DON'T HAVE A ZERO NODE AND WE CAN'T FIND ANY OTHER NODES
;ITS OBVIOUSLY A ROGUE POINTER
S KILLIT=1
Q
;
TRANSUM ;
S KILLIT=0
Q:$D(^ACHSF(FACILITY,"D",DOCNUM,"T",TRANNUM,0))
S TOTALMIS=TOTALMIS+1
S ^ACHSXREF(FACILITY,DOCNUM,TRANNUM,XREF)=$G(^ACHSXREF(FACILITY,DOCNUM,TRANNUM,XREF))+1
;W !!,"FAC: ",FACILITY
;W !,"DOC: ",DOCNUM
;W !,"TRAN:",TRANNUM
D DOCALL(FACILITY,DOCNUM) ;CHECK IF IT HAS OTHER NODES DEFINED
I 'BARE W !,"DATA FOUND IN OTHER NODES. INVESTIGATION NEEDED!" Q
S KILLIT=1
;
Q
;
;WHAT IF THE DOCUMENT DOESN'T HAVE A ZERO NODE BUT IT HAS OTHER NODES?
;
DOCALL(FACILITY,DOCNUM) ;
S BARE=1 ;ASSUME IT DOESN'T HAVE DATA
F SUB=1:1:11 D
.I $D(^ACHSF(FACILITY,"D",DOCNUM,SUB)) D
..;W !,"DATA IN NODE: ",SUB
..S BARE=0
Q
;CHECK DANGLING XREFS TO DOCUMENTS IN
;SAVED FILE /usr/spool/uucppublic/ ACHSF.SAV
COMPARE ;
;FORM OF THE COMMAND
;grep "\^ACHSF(4,\"D\",62,0)" /usr/spool/uucppublic/ACHSF.SAV
;LETS SEE IF THE SO CALLED "ARCHIVE" FILE IS OUT THERE.
S NOTOPEN=$$OPEN^%ZISH("/usr/spool/uucppublic/","ACHSF.SAV","R")
;
;5/2/01 pmf don't write this message out, it looks bad.
;record it, though. the message is worded to fall between
;the ENTERED message and the FINISHED message.
;I NOTOPEN W !!!,"CANNOT FIND FILE" Q
I NOTOPEN S ^ACHSINST(ACHSVERS,$ZN,"FIND ARCHIVE NEGATIVE")=NOW
;
S FILENAME="/usr/spool/uucppublic/ACHSF.SAV"
W !!,"SEARCHING TARGET FILE...."
S FACILITY=0
F FACCNT=1:1 S FACILITY=$O(^ACHSXREF(FACILITY)) Q:+FACILITY=0 D
.S DOCUMENT=""
.F DOCCNT=1:1 S DOCUMENT=$O(^ACHSXREF(FACILITY,DOCUMENT)) Q:DOCUMENT="" D
..W:DOCCNT#100 "."
..;IS ^ACHSF(FACILITY,"D",DOCUMENT,0) IN THE FILE?
..S TARGET="""\^ACHSF("_FACILITY_",\""D\"","_DOCUMENT_",0)"""
..S HOSTCMD="grep "_TARGET_" "_FILENAME
..S X=$$TERMINAL^%HOSTCMD(HOSTCMD)
..I X=0 S ^ACHSXREF("D",FACILITY,DOCUMENT)=""
..;
..S TRANNUM=""
..F TRANCNT=1:1 S TRANNUM=$O(^ACHSXREF(FACILITY,DOCUMENT,TRANNUM)) Q:TRANNUM="" D
...;IS ^ACHSF(FACILITY,"D",DOCUMENT,"T",TRANSACTION NUMBER,0) IN FILE?
...S TARGET="""\^ACHSF("_FACILITY_",\""D\"","_DOCUMENT_",\""T\"","_TRANNUM_",0)"""
...S HOSTCMD="grep "_TARGET_" "_FILENAME
...S X=$$TERMINAL^%HOSTCMD(HOSTCMD)
...I X=0 S ^ACHSXREF("T",FACILITY,DOCUMENT,TRANNUM)=""
;
Q
;
ERROR ;
I $G(ACHSVERS)="" S ACHSVERS="V3.1T1"
S ^ACHSINST(ACHSVERS,"ERROR",$ZN,"ERROR TRAP CALLED")=""
G ^%ET
Q
;
;CLEANUP
CLEANUP ;
K ACHSYAYA,DATE,DFN,DOCCNT,DOCNUM,DOCUMENT,FACCNT,FACILITY,FILENAME,FUNKYDT,HOSTCMD,NOTOPEN,PATNUM,PROVNUM,SUB,TARGET,TOTALMIS,TRANCNT,TRANNUM,TRANTYPE,X,XREF
Q
ACHSXREF ; IHS/ITSC/PMF - UNDOCUMENTED X-REF FIX FOR CHS FACILITY FILE [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 SET U="^"
+4 SET $ZT="ERROR^"_$ZN
+5 SET %H=$HOROLOG
DO YX^%DTC
SET NOW=Y
+6 IF $GET(ACHSVERS)=""
SET ACHSVERS="V3.1T1"
+7 ;
+8 SET ^ACHSINST(ACHSVERS,$ZN,"ENTERED")=NOW
+9 ;
+10 ;RESET GLOBAL COUNTER
SET ACHSYAYA=""
FOR
SET ACHSYAYA=$ORDER(^ACHSXREF(ACHSYAYA))
IF ACHSYAYA=""
QUIT
KILL ^(ACHSYAYA)
+11 KILL ACHSYAYA
+12 ;
+13 DO EOBD
+14 DO EOBP
+15 DO EOBR
+16 DO ES
+17 DO PB
+18 DO TB
+19 DO VB
+20 DO AC
+21 ;
+22 ;OKAY NOW LETS SEE IF ANY DANGLING XREFS FOUND ARE NOT IN THE
+23 ;SAVED FILE
+24 ;D COMPARE ;WILL NOT BE OF USE UNLESS 'ARCHIVE' FILE IS STILL AROUND
+25 DO CLEANUP
+26 ;
+27 SET %H=$HOROLOG
DO YX^%DTC
SET NOW=Y
+28 SET ^ACHSINST(ACHSVERS,$ZN,"FINISHED")=NOW
+29 ;
+30 QUIT
+31 ;
EOBD ;
+1 SET XREF="EOBD"
+2 SET TOTALMIS=0
+3 SET FACILITY=0
+4 WRITE !!,"CHECKING EOBD X-REFS...."
+5 WRITE !,"CROSS REFERENCE BY FUNKY DATE, DOCUMENT IEN, TRANSACTION IEN"
+6 FOR
SET FACILITY=$ORDER(^ACHSF(FACILITY))
IF +FACILITY=0
QUIT
Begin DoDot:1
+7 SET FUNKYDT=0
+8 FOR
SET FUNKYDT=$ORDER(^ACHSF(FACILITY,"EOBD",FUNKYDT))
IF +FUNKYDT=0
QUIT
Begin DoDot:2
+9 SET DOCNUM=0
+10 FOR
SET DOCNUM=$ORDER(^ACHSF(FACILITY,"EOBD",FUNKYDT,DOCNUM))
IF +DOCNUM=0
QUIT
Begin DoDot:3
+11 SET TRANNUM=0
+12 FOR
SET TRANNUM=$ORDER(^ACHSF(FACILITY,"EOBD",FUNKYDT,DOCNUM,TRANNUM))
IF +TRANNUM=0
QUIT
Begin DoDot:4
+13 DO DOCSUM
DO TRANSUM
End DoDot:4
+14 IF KILLIT
KILL ^ACHSF(FACILITY,"EOBD",FUNKYDT,DOCNUM)
WRITE !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_FUNKYDT_","_DOCNUM_")"
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 WRITE !,"TOTAL MISSING: ",TOTALMIS
+17 QUIT
+18 ;
+19 ;
EOBP ;
+1 SET XREF="EOBP"
+2 SET TOTALMIS=0
+3 SET FACILITY=0
+4 WRITE !!,"CHECKING EOBP X-REFS...."
+5 WRITE !,"CROSS REFERENCE BY PATEINT DFN , DOCUMENT IEN, TRANSACTION IEN"
+6 FOR
SET FACILITY=$ORDER(^ACHSF(FACILITY))
IF +FACILITY=0
QUIT
Begin DoDot:1
+7 SET PATNUM=0
+8 FOR
SET PATNUM=$ORDER(^ACHSF(FACILITY,"EOBP",PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:2
+9 SET DOCNUM=0
+10 FOR
SET DOCNUM=$ORDER(^ACHSF(FACILITY,"EOBP",PATNUM,DOCNUM))
IF +DOCNUM=0
QUIT
Begin DoDot:3
+11 SET TRANNUM=0
+12 FOR
SET TRANNUM=$ORDER(^ACHSF(FACILITY,"EOBP",PATNUM,DOCNUM,TRANNUM))
IF +TRANNUM=0
QUIT
Begin DoDot:4
+13 DO DOCSUM
DO TRANSUM
End DoDot:4
+14 IF KILLIT
KILL ^ACHSF(FACILITY,"EOBP",PATNUM,DOCNUM)
WRITE !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_PATNUM_","_DOCNUM_")"
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 WRITE !,"TOTAL MISSING: ",TOTALMIS
+17 QUIT
+18 ;
EOBR ;
+1 SET XREF="EOBR"
+2 WRITE !!,"CHECKING EOBR X-REFS....."
+3 WRITE !,"CROSS REFERENCE BY DOCUMENT IEN, TRANSACTION IEN, FUNKYDATE"
+4 SET TOTALMIS=0
+5 SET FACILITY=0
+6 FOR
SET FACILITY=$ORDER(^ACHSF(FACILITY))
IF +FACILITY=0
QUIT
Begin DoDot:1
+7 SET DOCNUM=0
+8 FOR
SET DOCNUM=$ORDER(^ACHSF(FACILITY,"EOBR",DOCNUM))
IF +DOCNUM=0
QUIT
Begin DoDot:2
+9 SET TRANNUM=0
+10 FOR
SET TRANNUM=$ORDER(^ACHSF(FACILITY,"EOBR",DOCNUM,TRANNUM))
IF +TRANNUM=0
QUIT
Begin DoDot:3
+11 DO DOCSUM
DO TRANSUM
End DoDot:3
+12 IF KILLIT
KILL ^ACHSF(FACILITY,"EOBR",DOCNUM)
WRITE !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_DOCNUM_")"
End DoDot:2
End DoDot:1
+13 ;
+14 WRITE !,"TOTAL MISSING: ",TOTALMIS
+15 QUIT
+16 ;
ES ;
+1 SET XREF="ES"
+2 SET TOTALMIS=0
+3 SET FACILITY=0
+4 WRITE !!,"CHECKING ES X-REFS...."
+5 WRITE !,"CROSS REFERENCE BY FUNKY DATE , DOCUMENT IEN"
+6 FOR
SET FACILITY=$ORDER(^ACHSF(FACILITY))
IF +FACILITY=0
QUIT
Begin DoDot:1
+7 SET FUNKYDT=0
+8 FOR
SET FUNKYDT=$ORDER(^ACHSF(FACILITY,"ES",FUNKYDT))
IF +FUNKYDT=0
QUIT
Begin DoDot:2
+9 SET DOCNUM=0
+10 FOR
SET DOCNUM=$ORDER(^ACHSF(FACILITY,"ES",FUNKYDT,DOCNUM))
IF +DOCNUM=0
QUIT
Begin DoDot:3
+11 DO DOCSUM
+12 IF KILLIT
KILL ^ACHSF(FACILITY,"ES",FUNKYDT,DOCNUM)
WRITE !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_FUNKYDT_","_DOCNUM_")"
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 WRITE !,"TOTAL MISSING: ",TOTALMIS
+15 QUIT
+16 ;
PB ;
+1 SET XREF="PB"
+2 WRITE !!,"CHECKING PB X-REFS....."
+3 WRITE !,"CROSS REFERENCE BY PATIENT DFN, DOCUMENT IEN, TRANSACTION IEN"
+4 SET TOTALMIS=0
+5 SET FACILITY=0
+6 FOR
SET FACILITY=$ORDER(^ACHSF(FACILITY))
IF +FACILITY=0
QUIT
Begin DoDot:1
+7 SET DFN=0
+8 FOR
SET DFN=$ORDER(^ACHSF(FACILITY,"PB",DFN))
IF +DFN=0
QUIT
Begin DoDot:2
+9 SET DOCNUM=0
+10 FOR
SET DOCNUM=$ORDER(^ACHSF(FACILITY,"PB",DFN,DOCNUM))
IF +DOCNUM=0
QUIT
Begin DoDot:3
+11 SET TRANNUM=0
+12 FOR
SET TRANNUM=$ORDER(^ACHSF(FACILITY,"PB",DFN,DOCNUM,TRANNUM))
IF +TRANNUM=0
QUIT
Begin DoDot:4
+13 DO DOCSUM
DO TRANSUM
+14 IF KILLIT
KILL ^ACHSF(FACILITY,"PB",DFN,DOCNUM,TRANNUM)
WRITE !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_DFN_","_DOCNUM_")"
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 WRITE !,"TOTAL MISSING: ",TOTALMIS
+17 QUIT
+18 ;
TB ;
+1 SET XREF="TB"
+2 WRITE !!,"CHECKING TB X-REFS....."
+3 WRITE !,"CROSS REFERENCE BY DATE, TRANSACTION TYPE, DOCUMENT IEN, TRANSACTION IEN"
+4 SET TOTALMIS=0
+5 SET FACILITY=0
+6 FOR
SET FACILITY=$ORDER(^ACHSF(FACILITY))
IF +FACILITY=0
QUIT
Begin DoDot:1
+7 SET DATE=0
+8 FOR
SET DATE=$ORDER(^ACHSF(FACILITY,"TB",DATE))
IF +DATE=0
QUIT
Begin DoDot:2
+9 SET TRANTYPE=""
+10 FOR
SET TRANTYPE=$ORDER(^ACHSF(FACILITY,"TB",DATE,TRANTYPE))
IF TRANTYPE=""
QUIT
Begin DoDot:3
+11 SET DOCNUM=0
+12 FOR
SET DOCNUM=$ORDER(^ACHSF(FACILITY,"TB",DATE,TRANTYPE,DOCNUM))
IF +DOCNUM=0
QUIT
Begin DoDot:4
+13 SET TRANNUM=0
+14 FOR
SET TRANNUM=$ORDER(^ACHSF(FACILITY,"TB",DATE,TRANTYPE,DOCNUM,TRANNUM))
IF +TRANNUM=0
QUIT
Begin DoDot:5
+15 DO DOCSUM
DO TRANSUM
End DoDot:5
End DoDot:4
+16 IF KILLIT
KILL ^ACHSF(FACILITY,"TB",DATE,TRANTYPE,DOCNUM)
WRITE !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_DATE_","_TRANTYPE_","_DOCNUM_")"
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 WRITE !,"TOTAL MISSING: ",TOTALMIS
+19 QUIT
+20 ;
VB ;
+1 SET XREF="VB"
+2 WRITE !!,"CHECKING VB X-REF....."
+3 WRITE !,"CROSS REFERENCE BY PROVIDER IEN, DOCUMENT IEN, TRANSACTION IEN"
+4 SET TOTALMIS=0
+5 SET FACILITY=0
+6 FOR
SET FACILITY=$ORDER(^ACHSF(FACILITY))
IF +FACILITY=0
QUIT
Begin DoDot:1
+7 SET PROVNUM=0
+8 FOR
SET PROVNUM=$ORDER(^ACHSF(FACILITY,"VB",PROVNUM))
IF +PROVNUM=0
QUIT
Begin DoDot:2
+9 SET DOCNUM=0
+10 FOR
SET DOCNUM=$ORDER(^ACHSF(FACILITY,"VB",PROVNUM,DOCNUM))
IF +DOCNUM=0
QUIT
Begin DoDot:3
+11 SET TRANNUM=0
+12 FOR
SET TRANNUM=$ORDER(^ACHSF(FACILITY,"VB",PROVNUM,DOCNUM,TRANNUM))
IF +TRANNUM=0
QUIT
Begin DoDot:4
+13 DO DOCSUM
DO TRANSUM
End DoDot:4
+14 IF KILLIT
KILL ^ACHSF(FACILITY,"VB",PROVNUM,DOCNUM)
WRITE !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_PROVNUM_","_DOCNUM_")"
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
+16 WRITE !,"TOTAL MISSING: ",TOTALMIS
+17 QUIT
+18 ;
AC ;
+1 SET XREF="AC"
+2 WRITE !!,"CHECKING AC X-REF...."
+3 WRITE !,"CROSS REFERENCE BY PROVIDER IEN, DOCUMENT IEN, TRANSACTION IEN"
+4 SET TOTALMIS=0
+5 SET PATNUM=0
+6 FOR
SET PATNUM=$ORDER(^ACHSF("AC",PATNUM))
IF +PATNUM=0
QUIT
Begin DoDot:1
+7 SET FACILITY=0
+8 FOR
SET FACILITY=$ORDER(^ACHSF("AC",PATNUM,FACILITY))
IF +FACILITY=0
QUIT
Begin DoDot:2
+9 SET DOCNUM=0
+10 FOR
SET DOCNUM=$ORDER(^ACHSF("AC",PATNUM,FACILITY,DOCNUM))
IF +DOCNUM=0
QUIT
Begin DoDot:3
+11 SET TRANNUM=0
+12 FOR
SET TRANNUM=$ORDER(^ACHSF("AC",PATNUM,FACILITY,DOCNUM,TRANNUM))
IF +TRANNUM=0
QUIT
Begin DoDot:4
+13 DO DOCSUM
DO TRANSUM
+14 IF KILLIT
KILL ^ACHSF("AC",PATNUM,FACILITY,DOCNUM)
WRITE !,"KILLING ^ACHSF("_XREF_","_PATNUM_","_FACILITY_","_DOCNUM_")"
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 WRITE !,"TOTAL MISSING: ",TOTALMIS
+16 QUIT
+17 ;
DOCSUM ;
+1 SET KILLIT=0
+2 IF $DATA(^ACHSF(FACILITY,"D",DOCNUM,0))
QUIT
+3 SET TOTALMIS=TOTALMIS+1
+4 SET ^ACHSXREF(FACILITY,DOCNUM,XREF)=$GET(^ACHSXREF(FACILITY,DOCNUM,XREF))+1
+5 ;W !!,"FAC: ",FACILITY
+6 ;W !,"DOC: ",DOCNUM
+7 ;CHECK FOR INFO IN OTHER DOCUMENT NODES
DO DOCALL(FACILITY,DOCNUM)
+8 IF 'BARE
WRITE !,"DATA WAS FOUND IN OTHER NODES FOR DOCUMENT "_DOCNUM_" IN FACILITY "_FACILITY_" . INVESTIGATION NEEDED!"
QUIT
+9 ;
+10 ;IF WE DON'T HAVE A ZERO NODE AND WE CAN'T FIND ANY OTHER NODES
+11 ;ITS OBVIOUSLY A ROGUE POINTER
+12 SET KILLIT=1
+13 QUIT
+14 ;
TRANSUM ;
+1 SET KILLIT=0
+2 IF $DATA(^ACHSF(FACILITY,"D",DOCNUM,"T",TRANNUM,0))
QUIT
+3 SET TOTALMIS=TOTALMIS+1
+4 SET ^ACHSXREF(FACILITY,DOCNUM,TRANNUM,XREF)=$GET(^ACHSXREF(FACILITY,DOCNUM,TRANNUM,XREF))+1
+5 ;W !!,"FAC: ",FACILITY
+6 ;W !,"DOC: ",DOCNUM
+7 ;W !,"TRAN:",TRANNUM
+8 ;CHECK IF IT HAS OTHER NODES DEFINED
DO DOCALL(FACILITY,DOCNUM)
+9 IF 'BARE
WRITE !,"DATA FOUND IN OTHER NODES. INVESTIGATION NEEDED!"
QUIT
+10 SET KILLIT=1
+11 ;
+12 QUIT
+13 ;
+14 ;WHAT IF THE DOCUMENT DOESN'T HAVE A ZERO NODE BUT IT HAS OTHER NODES?
+15 ;
DOCALL(FACILITY,DOCNUM) ;
+1 ;ASSUME IT DOESN'T HAVE DATA
SET BARE=1
+2 FOR SUB=1:1:11
Begin DoDot:1
+3 IF $DATA(^ACHSF(FACILITY,"D",DOCNUM,SUB))
Begin DoDot:2
+4 ;W !,"DATA IN NODE: ",SUB
+5 SET BARE=0
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;CHECK DANGLING XREFS TO DOCUMENTS IN
+8 ;SAVED FILE /usr/spool/uucppublic/ ACHSF.SAV
COMPARE ;
+1 ;FORM OF THE COMMAND
+2 ;grep "\^ACHSF(4,\"D\",62,0)" /usr/spool/uucppublic/ACHSF.SAV
+3 ;LETS SEE IF THE SO CALLED "ARCHIVE" FILE IS OUT THERE.
+4 SET NOTOPEN=$$OPEN^%ZISH("/usr/spool/uucppublic/","ACHSF.SAV","R")
+5 ;
+6 ;5/2/01 pmf don't write this message out, it looks bad.
+7 ;record it, though. the message is worded to fall between
+8 ;the ENTERED message and the FINISHED message.
+9 ;I NOTOPEN W !!!,"CANNOT FIND FILE" Q
+10 IF NOTOPEN
SET ^ACHSINST(ACHSVERS,$ZN,"FIND ARCHIVE NEGATIVE")=NOW
+11 ;
+12 SET FILENAME="/usr/spool/uucppublic/ACHSF.SAV"
+13 WRITE !!,"SEARCHING TARGET FILE...."
+14 SET FACILITY=0
+15 FOR FACCNT=1:1
SET FACILITY=$ORDER(^ACHSXREF(FACILITY))
IF +FACILITY=0
QUIT
Begin DoDot:1
+16 SET DOCUMENT=""
+17 FOR DOCCNT=1:1
SET DOCUMENT=$ORDER(^ACHSXREF(FACILITY,DOCUMENT))
IF DOCUMENT=""
QUIT
Begin DoDot:2
+18 IF DOCCNT#100
WRITE "."
+19 ;IS ^ACHSF(FACILITY,"D",DOCUMENT,0) IN THE FILE?
+20 SET TARGET="""\^ACHSF("_FACILITY_",\""D\"","_DOCUMENT_",0)"""
+21 SET HOSTCMD="grep "_TARGET_" "_FILENAME
+22 SET X=$$TERMINAL^%HOSTCMD(HOSTCMD)
+23 IF X=0
SET ^ACHSXREF("D",FACILITY,DOCUMENT)=""
+24 ;
+25 SET TRANNUM=""
+26 FOR TRANCNT=1:1
SET TRANNUM=$ORDER(^ACHSXREF(FACILITY,DOCUMENT,TRANNUM))
IF TRANNUM=""
QUIT
Begin DoDot:3
+27 ;IS ^ACHSF(FACILITY,"D",DOCUMENT,"T",TRANSACTION NUMBER,0) IN FILE?
+28 SET TARGET="""\^ACHSF("_FACILITY_",\""D\"","_DOCUMENT_",\""T\"","_TRANNUM_",0)"""
+29 SET HOSTCMD="grep "_TARGET_" "_FILENAME
+30 SET X=$$TERMINAL^%HOSTCMD(HOSTCMD)
+31 IF X=0
SET ^ACHSXREF("T",FACILITY,DOCUMENT,TRANNUM)=""
End DoDot:3
End DoDot:2
End DoDot:1
+32 ;
+33 QUIT
+34 ;
ERROR ;
+1 IF $GET(ACHSVERS)=""
SET ACHSVERS="V3.1T1"
+2 SET ^ACHSINST(ACHSVERS,"ERROR",$ZN,"ERROR TRAP CALLED")=""
+3 GOTO ^%ET
+4 QUIT
+5 ;
+6 ;CLEANUP
CLEANUP ;
+1 KILL ACHSYAYA,DATE,DFN,DOCCNT,DOCNUM,DOCUMENT,FACCNT,FACILITY,FILENAME,FUNKYDT,HOSTCMD,NOTOPEN,PATNUM,PROVNUM,SUB,TARGET,TOTALMIS,TRANCNT,TRANNUM,TRANTYPE,X,XREF
+2 QUIT
