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

ACHSXREF.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  S U="^"
  1.  S $ZT="ERROR^"_$ZN
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  I $G(ACHSVERS)="" S ACHSVERS="V3.1T1"
  1.  ;
  1.  S ^ACHSINST(ACHSVERS,$ZN,"ENTERED")=NOW
  1.  ;
  1.  S ACHSYAYA="" F  S ACHSYAYA=$O(^ACHSXREF(ACHSYAYA)) Q:ACHSYAYA=""  K ^(ACHSYAYA) ;RESET GLOBAL COUNTER
  1.  K ACHSYAYA
  1.  ;
  1.  D EOBD
  1.  D EOBP
  1.  D EOBR
  1.  D ES
  1.  D PB
  1.  D TB
  1.  D VB
  1.  D AC
  1.  ;
  1.  ;OKAY NOW LETS SEE IF ANY DANGLING XREFS FOUND ARE NOT IN THE
  1.  ;SAVED FILE
  1.  ;D COMPARE     ;WILL NOT BE OF USE UNLESS 'ARCHIVE' FILE IS STILL AROUND
  1.  D CLEANUP
  1.  ;
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,$ZN,"FINISHED")=NOW
  1.  ;
  1.  Q
  1.  ;
  1. EOBD ;
  1.  S XREF="EOBD"
  1.  S TOTALMIS=0
  1.  S FACILITY=0
  1.  W !!,"CHECKING EOBD X-REFS...."
  1.  W !,"CROSS REFERENCE BY FUNKY DATE, DOCUMENT IEN, TRANSACTION IEN"
  1.  F  S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0  D
  1.  .S FUNKYDT=0
  1.  .F  S FUNKYDT=$O(^ACHSF(FACILITY,"EOBD",FUNKYDT)) Q:+FUNKYDT=0  D
  1.  ..S DOCNUM=0
  1.  ..F  S DOCNUM=$O(^ACHSF(FACILITY,"EOBD",FUNKYDT,DOCNUM)) Q:+DOCNUM=0  D
  1.  ...S TRANNUM=0
  1.  ...F  S TRANNUM=$O(^ACHSF(FACILITY,"EOBD",FUNKYDT,DOCNUM,TRANNUM)) Q:+TRANNUM=0  D
  1.  ....D DOCSUM,TRANSUM
  1.  ...I KILLIT K ^ACHSF(FACILITY,"EOBD",FUNKYDT,DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_FUNKYDT_","_DOCNUM_")"
  1.  ;
  1.  W !,"TOTAL MISSING: ",TOTALMIS
  1.  Q
  1.  ;
  1.  ;
  1. EOBP ;
  1.  S XREF="EOBP"
  1.  S TOTALMIS=0
  1.  S FACILITY=0
  1.  W !!,"CHECKING EOBP X-REFS...."
  1.  W !,"CROSS REFERENCE BY PATEINT DFN , DOCUMENT IEN, TRANSACTION IEN"
  1.  F  S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0  D
  1.  .S PATNUM=0
  1.  .F  S PATNUM=$O(^ACHSF(FACILITY,"EOBP",PATNUM)) Q:+PATNUM=0  D
  1.  ..S DOCNUM=0
  1.  ..F  S DOCNUM=$O(^ACHSF(FACILITY,"EOBP",PATNUM,DOCNUM)) Q:+DOCNUM=0  D
  1.  ...S TRANNUM=0
  1.  ...F  S TRANNUM=$O(^ACHSF(FACILITY,"EOBP",PATNUM,DOCNUM,TRANNUM)) Q:+TRANNUM=0  D
  1.  ....D DOCSUM,TRANSUM
  1.  ...I KILLIT K ^ACHSF(FACILITY,"EOBP",PATNUM,DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_PATNUM_","_DOCNUM_")"
  1.  ;
  1.  W !,"TOTAL MISSING: ",TOTALMIS
  1.  Q
  1.  ;
  1. EOBR ;
  1.  S XREF="EOBR"
  1.  W !!,"CHECKING EOBR X-REFS....."
  1.  W !,"CROSS REFERENCE BY DOCUMENT IEN, TRANSACTION IEN, FUNKYDATE"
  1.  S TOTALMIS=0
  1.  S FACILITY=0
  1.  F  S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0  D
  1.  .S DOCNUM=0
  1.  .F  S DOCNUM=$O(^ACHSF(FACILITY,"EOBR",DOCNUM)) Q:+DOCNUM=0  D
  1.  ..S TRANNUM=0
  1.  ..F  S TRANNUM=$O(^ACHSF(FACILITY,"EOBR",DOCNUM,TRANNUM)) Q:+TRANNUM=0  D
  1.  ...D DOCSUM,TRANSUM
  1.  ..I KILLIT K ^ACHSF(FACILITY,"EOBR",DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_DOCNUM_")"
  1.  ;
  1.  W !,"TOTAL MISSING: ",TOTALMIS
  1.  Q
  1.  ;
  1. ES ;
  1.  S XREF="ES"
  1.  S TOTALMIS=0
  1.  S FACILITY=0
  1.  W !!,"CHECKING ES X-REFS...."
  1.  W !,"CROSS REFERENCE BY FUNKY DATE , DOCUMENT IEN"
  1.  F  S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0  D
  1.  .S FUNKYDT=0
  1.  .F  S FUNKYDT=$O(^ACHSF(FACILITY,"ES",FUNKYDT)) Q:+FUNKYDT=0  D
  1.  ..S DOCNUM=0
  1.  ..F  S DOCNUM=$O(^ACHSF(FACILITY,"ES",FUNKYDT,DOCNUM)) Q:+DOCNUM=0  D
  1.  ...D DOCSUM
  1.  ...I KILLIT K ^ACHSF(FACILITY,"ES",FUNKYDT,DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_FUNKYDT_","_DOCNUM_")"
  1.  ;
  1.  W !,"TOTAL MISSING: ",TOTALMIS
  1.  Q
  1.  ;
  1. PB ;
  1.  S XREF="PB"
  1.  W !!,"CHECKING PB X-REFS....."
  1.  W !,"CROSS REFERENCE BY PATIENT DFN, DOCUMENT IEN, TRANSACTION IEN"
  1.  S TOTALMIS=0
  1.  S FACILITY=0
  1.  F  S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0  D
  1.  .S DFN=0
  1.  .F  S DFN=$O(^ACHSF(FACILITY,"PB",DFN)) Q:+DFN=0  D
  1.  ..S DOCNUM=0
  1.  ..F  S DOCNUM=$O(^ACHSF(FACILITY,"PB",DFN,DOCNUM)) Q:+DOCNUM=0  D
  1.  ...S TRANNUM=0
  1.  ...F  S TRANNUM=$O(^ACHSF(FACILITY,"PB",DFN,DOCNUM,TRANNUM)) Q:+TRANNUM=0  D
  1.  ....D DOCSUM,TRANSUM
  1.  ....I KILLIT K ^ACHSF(FACILITY,"PB",DFN,DOCNUM,TRANNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_DFN_","_DOCNUM_")"
  1.  ;
  1.  W !,"TOTAL MISSING: ",TOTALMIS
  1.  Q
  1.  ;
  1. TB ;
  1.  S XREF="TB"
  1.  W !!,"CHECKING TB X-REFS....."
  1.  W !,"CROSS REFERENCE BY DATE, TRANSACTION TYPE, DOCUMENT IEN, TRANSACTION IEN"
  1.  S TOTALMIS=0
  1.  S FACILITY=0
  1.  F  S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0  D
  1.  .S DATE=0
  1.  .F  S DATE=$O(^ACHSF(FACILITY,"TB",DATE)) Q:+DATE=0  D
  1.  ..S TRANTYPE=""
  1.  ..F  S TRANTYPE=$O(^ACHSF(FACILITY,"TB",DATE,TRANTYPE)) Q:TRANTYPE=""  D
  1.  ...S DOCNUM=0
  1.  ...F  S DOCNUM=$O(^ACHSF(FACILITY,"TB",DATE,TRANTYPE,DOCNUM)) Q:+DOCNUM=0  D
  1.  ....S TRANNUM=0
  1.  ....F  S TRANNUM=$O(^ACHSF(FACILITY,"TB",DATE,TRANTYPE,DOCNUM,TRANNUM)) Q:+TRANNUM=0  D
  1.  .....D DOCSUM,TRANSUM
  1.  ...I KILLIT K ^ACHSF(FACILITY,"TB",DATE,TRANTYPE,DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_DATE_","_TRANTYPE_","_DOCNUM_")"
  1.  ;
  1.  W !,"TOTAL MISSING: ",TOTALMIS
  1.  Q
  1.  ;
  1. VB ;
  1.  S XREF="VB"
  1.  W !!,"CHECKING VB X-REF....."
  1.  W !,"CROSS REFERENCE BY PROVIDER IEN, DOCUMENT IEN, TRANSACTION IEN"
  1.  S TOTALMIS=0
  1.  S FACILITY=0
  1.  F  S FACILITY=$O(^ACHSF(FACILITY)) Q:+FACILITY=0  D
  1.  .S PROVNUM=0
  1.  .F  S PROVNUM=$O(^ACHSF(FACILITY,"VB",PROVNUM)) Q:+PROVNUM=0  D
  1.  ..S DOCNUM=0
  1.  ..F  S DOCNUM=$O(^ACHSF(FACILITY,"VB",PROVNUM,DOCNUM)) Q:+DOCNUM=0  D
  1.  ...S TRANNUM=0
  1.  ...F  S TRANNUM=$O(^ACHSF(FACILITY,"VB",PROVNUM,DOCNUM,TRANNUM)) Q:+TRANNUM=0  D
  1.  ....D DOCSUM,TRANSUM
  1.  ...I KILLIT K ^ACHSF(FACILITY,"VB",PROVNUM,DOCNUM) W !,"KILLING ^ACHSF("_FACILITY_","_XREF_","_PROVNUM_","_DOCNUM_")"
  1.  ;
  1.  W !,"TOTAL MISSING: ",TOTALMIS
  1.  Q
  1.  ;
  1. AC ;
  1.  S XREF="AC"
  1.  W !!,"CHECKING AC X-REF...."
  1.  W !,"CROSS REFERENCE BY PROVIDER IEN, DOCUMENT IEN, TRANSACTION IEN"
  1.  S TOTALMIS=0
  1.  S PATNUM=0
  1.  F  S PATNUM=$O(^ACHSF("AC",PATNUM)) Q:+PATNUM=0  D
  1.  .S FACILITY=0
  1.  .F  S FACILITY=$O(^ACHSF("AC",PATNUM,FACILITY)) Q:+FACILITY=0  D
  1.  ..S DOCNUM=0
  1.  ..F  S DOCNUM=$O(^ACHSF("AC",PATNUM,FACILITY,DOCNUM)) Q:+DOCNUM=0  D
  1.  ...S TRANNUM=0
  1.  ...F  S TRANNUM=$O(^ACHSF("AC",PATNUM,FACILITY,DOCNUM,TRANNUM)) Q:+TRANNUM=0  D
  1.  ....D DOCSUM,TRANSUM
  1.  ....I KILLIT K ^ACHSF("AC",PATNUM,FACILITY,DOCNUM) W !,"KILLING ^ACHSF("_XREF_","_PATNUM_","_FACILITY_","_DOCNUM_")"
  1.  W !,"TOTAL MISSING: ",TOTALMIS
  1.  Q
  1.  ;
  1. DOCSUM ;
  1.  S KILLIT=0
  1.  Q:$D(^ACHSF(FACILITY,"D",DOCNUM,0))
  1.  S TOTALMIS=TOTALMIS+1
  1.  S ^ACHSXREF(FACILITY,DOCNUM,XREF)=$G(^ACHSXREF(FACILITY,DOCNUM,XREF))+1
  1.  ;W !!,"FAC: ",FACILITY
  1.  ;W !,"DOC: ",DOCNUM
  1.  D DOCALL(FACILITY,DOCNUM)      ;CHECK FOR INFO IN OTHER DOCUMENT NODES
  1.  I 'BARE W !,"DATA WAS FOUND IN OTHER NODES FOR DOCUMENT "_DOCNUM_" IN FACILITY "_FACILITY_" . INVESTIGATION NEEDED!" Q
  1.  ;
  1.  ;IF WE DON'T HAVE A ZERO NODE AND WE CAN'T FIND ANY OTHER NODES
  1.  ;ITS OBVIOUSLY A ROGUE POINTER
  1.  S KILLIT=1
  1.  Q
  1.  ;
  1. TRANSUM ;
  1.  S KILLIT=0
  1.  Q:$D(^ACHSF(FACILITY,"D",DOCNUM,"T",TRANNUM,0))
  1.  S TOTALMIS=TOTALMIS+1
  1.  S ^ACHSXREF(FACILITY,DOCNUM,TRANNUM,XREF)=$G(^ACHSXREF(FACILITY,DOCNUM,TRANNUM,XREF))+1
  1.  ;W !!,"FAC: ",FACILITY
  1.  ;W !,"DOC: ",DOCNUM
  1.  ;W !,"TRAN:",TRANNUM
  1.  D DOCALL(FACILITY,DOCNUM)          ;CHECK IF IT HAS OTHER NODES DEFINED
  1.  I 'BARE W !,"DATA FOUND IN OTHER NODES. INVESTIGATION NEEDED!" Q
  1.  S KILLIT=1
  1.  ;
  1.  Q
  1.  ;
  1.  ;WHAT IF THE DOCUMENT DOESN'T HAVE A ZERO NODE BUT IT HAS OTHER NODES?
  1.  ;
  1. DOCALL(FACILITY,DOCNUM) ;
  1.  S BARE=1      ;ASSUME IT DOESN'T HAVE DATA
  1.  F SUB=1:1:11 D
  1.  .I $D(^ACHSF(FACILITY,"D",DOCNUM,SUB)) D
  1.  ..;W !,"DATA IN NODE: ",SUB
  1.  ..S BARE=0
  1.  Q
  1.  ;CHECK DANGLING XREFS TO DOCUMENTS IN
  1.  ;SAVED FILE /usr/spool/uucppublic/ ACHSF.SAV
  1. COMPARE ;
  1.  ;FORM OF THE COMMAND
  1.  ;grep "\^ACHSF(4,\"D\",62,0)" /usr/spool/uucppublic/ACHSF.SAV
  1.  ;LETS SEE IF THE SO CALLED "ARCHIVE" FILE IS OUT THERE.
  1.  S NOTOPEN=$$OPEN^%ZISH("/usr/spool/uucppublic/","ACHSF.SAV","R")
  1.  ;
  1.  ;5/2/01   pmf   don't write this message out, it looks bad.
  1.  ;record it, though.  the message is worded to fall between
  1.  ;the ENTERED message and the FINISHED message.
  1.  ;I NOTOPEN W !!!,"CANNOT FIND FILE" Q
  1.  I NOTOPEN S ^ACHSINST(ACHSVERS,$ZN,"FIND ARCHIVE NEGATIVE")=NOW
  1.  ;
  1.  S FILENAME="/usr/spool/uucppublic/ACHSF.SAV"
  1.  W !!,"SEARCHING TARGET FILE...."
  1.  S FACILITY=0
  1.  F FACCNT=1:1 S FACILITY=$O(^ACHSXREF(FACILITY)) Q:+FACILITY=0  D
  1.  .S DOCUMENT=""
  1.  .F DOCCNT=1:1 S DOCUMENT=$O(^ACHSXREF(FACILITY,DOCUMENT)) Q:DOCUMENT=""  D
  1.  ..W:DOCCNT#100 "."
  1.  ..;IS ^ACHSF(FACILITY,"D",DOCUMENT,0) IN THE FILE?
  1.  ..S TARGET="""\^ACHSF("_FACILITY_",\""D\"","_DOCUMENT_",0)"""
  1.  ..S HOSTCMD="grep "_TARGET_" "_FILENAME
  1.  ..S X=$$TERMINAL^%HOSTCMD(HOSTCMD)
  1.  ..I X=0 S ^ACHSXREF("D",FACILITY,DOCUMENT)=""
  1.  ..;
  1.  ..S TRANNUM=""
  1.  ..F TRANCNT=1:1 S TRANNUM=$O(^ACHSXREF(FACILITY,DOCUMENT,TRANNUM)) Q:TRANNUM=""  D
  1.  ...;IS ^ACHSF(FACILITY,"D",DOCUMENT,"T",TRANSACTION NUMBER,0) IN FILE?
  1.  ...S TARGET="""\^ACHSF("_FACILITY_",\""D\"","_DOCUMENT_",\""T\"","_TRANNUM_",0)"""
  1.  ...S HOSTCMD="grep "_TARGET_" "_FILENAME
  1.  ...S X=$$TERMINAL^%HOSTCMD(HOSTCMD)
  1.  ...I X=0 S ^ACHSXREF("T",FACILITY,DOCUMENT,TRANNUM)=""
  1.  ;
  1.  Q
  1.  ;
  1. ERROR ;
  1.  I $G(ACHSVERS)="" S ACHSVERS="V3.1T1"
  1.  S ^ACHSINST(ACHSVERS,"ERROR",$ZN,"ERROR TRAP CALLED")=""
  1.  G ^%ET
  1.  Q
  1.  ;
  1.  ;CLEANUP
  1. CLEANUP ;
  1.  K ACHSYAYA,DATE,DFN,DOCCNT,DOCNUM,DOCUMENT,FACCNT,FACILITY,FILENAME,FUNKYDT,HOSTCMD,NOTOPEN,PATNUM,PROVNUM,SUB,TARGET,TOTALMIS,TRANCNT,TRANNUM,TRANTYPE,X,XREF
  1.  Q