VSITKIL ;ISL/ARS,JVS - NON INTERACTIVE CHECK DEPENDENT ENTRY COUNT ;May 17, 2017@12:01
;;1.0;PCE PATIENT CARE ENCOUNTER;**76,204,211**;Aug 12, 1996;Build 454
; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
; the incorporation of the module into PCE. For historical reference,
; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
; patches.
;
;;2.0;VISIT TRACKING;**1,2**;Aug 12, 1996
;;
KILL(VSITKDFN) ; ENTER THE VSIT YOU WANT CHECKED SET VSITKDFN=IEN
; VSITKDFN = Vsit Ien REQUIRED
;
N DIK,VSITKDEC,VSITKND,LOCK,ERROR
S VSITKND=""
G:$G(VSITKDFN)'?1.N XIT
G:$D(^XTMP("AUPNVSIT",VSITKDFN)) XIT
S LOCK=$$LOCK^PXLOCK(VSITKDFN,DUZ,2,.ERROR,"VSITKIL")
G:'LOCK XIT
I '$D(^AUPNVSIT(VSITKDFN,0)) D UNLOCK^PXLOCK(VSITKDFN,DUZ,"VSITKIL") G XIT
;
S VSITKDEC=$P(^AUPNVSIT(VSITKDFN,0),U,9)
S VSITKND=$$DEC^VSITKIL(VSITKDFN)
I VSITKND'=VSITKDEC S $P(^AUPNVSIT(VSITKDFN,0),U,9)=VSITKND,VSITKDEC=VSITKND
;Check delete flag and reindex
I VSITKND>0,$P(^AUPNVSIT(VSITKDFN,0),U,11)=1 D
. S $P(^AUPNVSIT(VSITKDFN,0),U,11)=0
. S DA=VSITKDFN
. S DIK="^AUPNVSIT("
. D IX^DIK
. K DIK,DA,DR
I VSITKND=0 D
. S DIK="^AUPNVSIT("
. S DA=VSITKDFN
. D ^DIK
. K DIK,DA
. D UNLOCK^PXLOCK(VSITKDFN,DUZ,"VSITKIL")
. K VSITKDFN
E D UNLOCK^PXLOCK(VSITKDFN,DUZ,"VSITKIL")
XIT ;exit
Q VSITKND
;
DOC ; This routine checks the dependent entry count of the VISIT file for
; accuracy. If it is not correct it is replaced with a correct count
; The count is determined by scanning each of the VISIT related
; files for entries that point to that VISIT. A count is incremented
; each time a "hit" is made.
; The user can enter the visit IEN and if there is not any entries
; pointing to the entry it is deleted. (not logically but totally)
Q
;
DEC(VISIT,VISUAL) ;Test looking through DD to find fields pointing to the visit entries.
; VISIT=Visit ien to looked up and counted
; VISUAL= Set to 1 if you want and interactive display of what is found
;
; Look for file and field
;
N COUNT,FIELD,FILE,GET,PIECE,PX,REF,SNDPIECE,STOP,SUB,VAUGHN
N VDD,VDDN,VDDR
;
S FILE=""
F S FILE=$O(^DD(9000010,0,"PT",FILE)) Q:FILE="" D
.S FIELD=""
.F S FIELD=$O(^DD(9000010,0,"PT",FILE,FIELD)) Q:FIELD="" D
..S VDD(FILE,FIELD)=""
D REF,QUE
K VDDN,VDDR
I $G(VISUAL) W !,"COUNT= "
Q COUNT
;
REF ;Look for all of the regular cross references and other
;
S FILE="" F S FILE=$O(VDD(FILE)) Q:FILE="" D
.S FIELD="" F S FIELD=$O(VDD(FILE,FIELD)) Q:FIELD="" D
..D REG
K VDD
Q
;
REG ;Look for regular cross references
;
S STOP=0
I '$D(^DD(FILE,FIELD,1)) S VDDN(FILE,FIELD)="" Q
S SUB=0 F S SUB=$O(^DD(FILE,FIELD,1,SUB)) Q:SUB="" D
.S GET=$G(^DD(FILE,FIELD,1,SUB,0))
.I $P(GET,U,3)']"" S VDDR(FILE,SUB)=FILE_U_FIELD_U_SUB S STOP=1
.E S VDDN(FILE,FIELD)=""
Q
QUE ;CHECK OUT CROSS REFERENCE
;
S FILE="",FIELD="",COUNT=0
F S FILE=$O(VDDR(FILE)) Q:FILE="" D
.S SUB=0 F S SUB=$O(VDDR(FILE,SUB)) Q:SUB="" S GET=$G(VDDR(FILE,SUB)) D
..S REF=$G(^DD($P(GET,U,1),$P(GET,U,2),1,$P(GET,U,3),1))
..I $P(REF,"""",1)["DA(1)" Q
..S PIECE=$P(REF," ",2)
..S SNDPIECE=$P(PIECE,"""",1,2)_""""
..S VAUGHN=$P(PIECE,"""",1,2)_""")"
..I $D(@VAUGHN) D
...S PX=SNDPIECE_",VISIT)"
...I $D(@PX) S COUNT=COUNT+$$COUNT(PX)
Q
;
COUNT(NPX,UPPER) ;COUNT ENTRIES IN FILES AND SUB-FILES
N LEVEL,TOTAL
I $G(UPPER)'="" S NPX=$P(NPX,")")_","_UPPER_")"
S LEVEL=0 F S LEVEL=$O(@NPX@(LEVEL)) Q:'+LEVEL D
.I $D(@NPX@(LEVEL))>9 S TOTAL=$G(TOTAL)+$$COUNT(NPX,LEVEL)
.I $D(@NPX@(LEVEL))<10 S TOTAL=$G(TOTAL)+1 W:$G(VISUAL) !," ",$P($NA(@NPX),")")_","_LEVEL
Q +$G(TOTAL)
COMP ;COMPARE DEC WITH WHAT UTILITY SAYS
;Call this entry point to loop through the entire file to see the
;dependent entry points that aren't accurate
;
N CNT,DEC,DEC1,KYRON
;
S CNT=0
S KYRON=0 F S KYRON=$O(^AUPNVSIT(KYRON)) Q:KYRON'>0 D
.S DEC=$P(^AUPNVSIT(KYRON,0),U,9)
.S DEC1=$$DEC^VSITKIL(KYRON,0)
.I DEC="",DEC1=0 ;ok, both are zero
.E I DEC'=DEC1 D
..W !,"Visit= "_KYRON,?20,"Entry's Dependent Entry Count= "_DEC,?56,"Found= "_DEC1,?68,"BAD"
..S CNT=CNT+1
..S DEC1=$$DEC^VSITKIL(KYRON,1)
W !!,"BAD COUNTS "_CNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVSITKIL 4291 printed Apr 09, 2024@21:34:27 Page 2
VSITKIL ;ISL/ARS,JVS - NON INTERACTIVE CHECK DEPENDENT ENTRY COUNT ;May 17, 2017@12:01
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76,204,211**;Aug 12, 1996;Build 454
+2 ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
+3 ; the incorporation of the module into PCE. For historical reference,
+4 ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
+5 ; patches.
+6 ;
+7 ;;2.0;VISIT TRACKING;**1,2**;Aug 12, 1996
+8 ;;
KILL(VSITKDFN) ; ENTER THE VSIT YOU WANT CHECKED SET VSITKDFN=IEN
+1 ; VSITKDFN = Vsit Ien REQUIRED
+2 ;
+3 NEW DIK,VSITKDEC,VSITKND,LOCK,ERROR
+4 SET VSITKND=""
+5 if $GET(VSITKDFN)'?1.N
GOTO XIT
+6 if $DATA(^XTMP("AUPNVSIT",VSITKDFN))
GOTO XIT
+7 SET LOCK=$$LOCK^PXLOCK(VSITKDFN,DUZ,2,.ERROR,"VSITKIL")
+8 if 'LOCK
GOTO XIT
+9 IF '$DATA(^AUPNVSIT(VSITKDFN,0))
DO UNLOCK^PXLOCK(VSITKDFN,DUZ,"VSITKIL")
GOTO XIT
+10 ;
+11 SET VSITKDEC=$PIECE(^AUPNVSIT(VSITKDFN,0),U,9)
+12 SET VSITKND=$$DEC^VSITKIL(VSITKDFN)
+13 IF VSITKND'=VSITKDEC
SET $PIECE(^AUPNVSIT(VSITKDFN,0),U,9)=VSITKND
SET VSITKDEC=VSITKND
+14 ;Check delete flag and reindex
+15 IF VSITKND>0
IF $PIECE(^AUPNVSIT(VSITKDFN,0),U,11)=1
Begin DoDot:1
+16 SET $PIECE(^AUPNVSIT(VSITKDFN,0),U,11)=0
+17 SET DA=VSITKDFN
+18 SET DIK="^AUPNVSIT("
+19 DO IX^DIK
+20 KILL DIK,DA,DR
End DoDot:1
+21 IF VSITKND=0
Begin DoDot:1
+22 SET DIK="^AUPNVSIT("
+23 SET DA=VSITKDFN
+24 DO ^DIK
+25 KILL DIK,DA
+26 DO UNLOCK^PXLOCK(VSITKDFN,DUZ,"VSITKIL")
+27 KILL VSITKDFN
End DoDot:1
+28 IF '$TEST
DO UNLOCK^PXLOCK(VSITKDFN,DUZ,"VSITKIL")
XIT ;exit
+1 QUIT VSITKND
+2 ;
DOC ; This routine checks the dependent entry count of the VISIT file for
+1 ; accuracy. If it is not correct it is replaced with a correct count
+2 ; The count is determined by scanning each of the VISIT related
+3 ; files for entries that point to that VISIT. A count is incremented
+4 ; each time a "hit" is made.
+5 ; The user can enter the visit IEN and if there is not any entries
+6 ; pointing to the entry it is deleted. (not logically but totally)
+7 QUIT
+8 ;
DEC(VISIT,VISUAL) ;Test looking through DD to find fields pointing to the visit entries.
+1 ; VISIT=Visit ien to looked up and counted
+2 ; VISUAL= Set to 1 if you want and interactive display of what is found
+3 ;
+4 ; Look for file and field
+5 ;
+6 NEW COUNT,FIELD,FILE,GET,PIECE,PX,REF,SNDPIECE,STOP,SUB,VAUGHN
+7 NEW VDD,VDDN,VDDR
+8 ;
+9 SET FILE=""
+10 FOR
SET FILE=$ORDER(^DD(9000010,0,"PT",FILE))
if FILE=""
QUIT
Begin DoDot:1
+11 SET FIELD=""
+12 FOR
SET FIELD=$ORDER(^DD(9000010,0,"PT",FILE,FIELD))
if FIELD=""
QUIT
Begin DoDot:2
+13 SET VDD(FILE,FIELD)=""
End DoDot:2
End DoDot:1
+14 DO REF
DO QUE
+15 KILL VDDN,VDDR
+16 IF $GET(VISUAL)
WRITE !,"COUNT= "
+17 QUIT COUNT
+18 ;
REF ;Look for all of the regular cross references and other
+1 ;
+2 SET FILE=""
FOR
SET FILE=$ORDER(VDD(FILE))
if FILE=""
QUIT
Begin DoDot:1
+3 SET FIELD=""
FOR
SET FIELD=$ORDER(VDD(FILE,FIELD))
if FIELD=""
QUIT
Begin DoDot:2
+4 DO REG
End DoDot:2
End DoDot:1
+5 KILL VDD
+6 QUIT
+7 ;
REG ;Look for regular cross references
+1 ;
+2 SET STOP=0
+3 IF '$DATA(^DD(FILE,FIELD,1))
SET VDDN(FILE,FIELD)=""
QUIT
+4 SET SUB=0
FOR
SET SUB=$ORDER(^DD(FILE,FIELD,1,SUB))
if SUB=""
QUIT
Begin DoDot:1
+5 SET GET=$GET(^DD(FILE,FIELD,1,SUB,0))
+6 IF $PIECE(GET,U,3)']""
SET VDDR(FILE,SUB)=FILE_U_FIELD_U_SUB
SET STOP=1
+7 IF '$TEST
SET VDDN(FILE,FIELD)=""
End DoDot:1
+8 QUIT
QUE ;CHECK OUT CROSS REFERENCE
+1 ;
+2 SET FILE=""
SET FIELD=""
SET COUNT=0
+3 FOR
SET FILE=$ORDER(VDDR(FILE))
if FILE=""
QUIT
Begin DoDot:1
+4 SET SUB=0
FOR
SET SUB=$ORDER(VDDR(FILE,SUB))
if SUB=""
QUIT
SET GET=$GET(VDDR(FILE,SUB))
Begin DoDot:2
+5 SET REF=$GET(^DD($PIECE(GET,U,1),$PIECE(GET,U,2),1,$PIECE(GET,U,3),1))
+6 IF $PIECE(REF,"""",1)["DA(1)"
QUIT
+7 SET PIECE=$PIECE(REF," ",2)
+8 SET SNDPIECE=$PIECE(PIECE,"""",1,2)_""""
+9 SET VAUGHN=$PIECE(PIECE,"""",1,2)_""")"
+10 IF $DATA(@VAUGHN)
Begin DoDot:3
+11 SET PX=SNDPIECE_",VISIT)"
+12 IF $DATA(@PX)
SET COUNT=COUNT+$$COUNT(PX)
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
COUNT(NPX,UPPER) ;COUNT ENTRIES IN FILES AND SUB-FILES
+1 NEW LEVEL,TOTAL
+2 IF $GET(UPPER)'=""
SET NPX=$PIECE(NPX,")")_","_UPPER_")"
+3 SET LEVEL=0
FOR
SET LEVEL=$ORDER(@NPX@(LEVEL))
if '+LEVEL
QUIT
Begin DoDot:1
+4 IF $DATA(@NPX@(LEVEL))>9
SET TOTAL=$GET(TOTAL)+$$COUNT(NPX,LEVEL)
+5 IF $DATA(@NPX@(LEVEL))<10
SET TOTAL=$GET(TOTAL)+1
if $GET(VISUAL)
WRITE !," ",$PIECE($NAME(@NPX),")")_","_LEVEL
End DoDot:1
+6 QUIT +$GET(TOTAL)
COMP ;COMPARE DEC WITH WHAT UTILITY SAYS
+1 ;Call this entry point to loop through the entire file to see the
+2 ;dependent entry points that aren't accurate
+3 ;
+4 NEW CNT,DEC,DEC1,KYRON
+5 ;
+6 SET CNT=0
+7 SET KYRON=0
FOR
SET KYRON=$ORDER(^AUPNVSIT(KYRON))
if KYRON'>0
QUIT
Begin DoDot:1
+8 SET DEC=$PIECE(^AUPNVSIT(KYRON,0),U,9)
+9 SET DEC1=$$DEC^VSITKIL(KYRON,0)
+10 ;ok, both are zero
IF DEC=""
IF DEC1=0
+11 IF '$TEST
IF DEC'=DEC1
Begin DoDot:2
+12 WRITE !,"Visit= "_KYRON,?20,"Entry's Dependent Entry Count= "_DEC,?56,"Found= "_DEC1,?68,"BAD"
+13 SET CNT=CNT+1
+14 SET DEC1=$$DEC^VSITKIL(KYRON,1)
End DoDot:2
End DoDot:1
+15 WRITE !!,"BAD COUNTS "_CNT
+16 QUIT
