DGRPCU ;ALB/MRL,BAJ - CONSISTENCY FLAGGER, CHECK EXISTING ; NOV 18, 2005
;;5.3;Registration;**653**;Aug 13, 1993;Build 2
S U="^" D DT^DICRW F I=1:1 S J=$P($T(T+I),";;",2) Q:J']"" W !,J
D ^DGRPCS G Q:DGCONRUN S Y=$S($D(^DG(43,1,"CON")):$P(^("CON"),"^",6),1:"") I +Y X ^DD("DD") W !!,"LAST RUN COMPLETED: ",Y
OK W !!,"Do you really want to update existing inconsistent entries" S %=2 D YN^DICN G Q:%=2!(%=-1)
I '% W !!?4,"Y - If you want me to run through all the entries currently filed in",!?9,"the INCONSISTENT DATA file and verify they're still inconsistent.",!?4,"N - If you wish to QUIT and rethink this action." G OK
S ION="",DGPGM="ST^DGRPCU",DGVAR="DUZ" D QUE^DGUTQ S IOP="HOME" D ^%ZIS K IOP
Q K DFN,DGCONRUN,DGPGM,DGTIME,DGVAR,I,J,Y,%,%Y,PASS D CLOSE^DGUTQ Q
; DG*5.3*653 BAJ Added call to Z07 Consistency checker
ST D H^DGUTL S $P(^DG(43,1,"CON"),"^",5)=DGTIME F DFN=0:0 S DFN=$O(^DGIN(38.5,DFN)) Q:'DFN D EN^DGRPC S PASS=$$EN^IVMZ07C(DFN)
D H^DGUTL S $P(^DG(43,1,"CON"),"^",6)=DGTIME G Q
T ;
;;This option is designed to loop through the existing entries in the INCONSISTENT
;;DATA file and verify that all elements are still inconsistent. This function
;;is necessary because some data may get updated by means where the consistency
;;checker isn't automatically run, i.e., VA FileMan. If you wish to in fact run
;;this option simply respond YES when asked and enter the DATE/TIME you wish the
;;option to commence running.
;
;
UPD ;update file 38.5 - called from DG CONSISTENCY CHECK option
D ON^DGRPC G KVAR^DGRPCE:DGER W !! S DGEDIT=1,DIC="^DGIN(38.6,",DIC(0)="AEQMZ",DIC("S")="I Y'=21" D ^DIC G KVAR^DGRPCE:Y'>0 S DGD=+Y
S DGL="",$P(DGL,"=",80)="" W !,DGL F I=0:0 S I=$O(^DGIN(38.6,+DGD,"D",I)) Q:'I W !,^(I,0)
I "^2^9^10^13^14^22^51^52^53^"[("^"_DGD_"^") W !!,*7,"This check can not be edited. It is automatically turned ",$S(DGD=2:"OFF",DGD=51:"OFF",1:"ON"),"!",!,DGL G UPDQ
W !,DGL S (DA,Y)=DGD,DIE=DIC,DR="5;" K DG,DQ D ^DIE
UPDQ K DA,DGD,DGEDIT,DGER,DGL,DR,DIC,DIE,I,X,Y
G UPD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPCU 2052 printed Oct 16, 2024@18:56:42 Page 2
DGRPCU ;ALB/MRL,BAJ - CONSISTENCY FLAGGER, CHECK EXISTING ; NOV 18, 2005
+1 ;;5.3;Registration;**653**;Aug 13, 1993;Build 2
+2 SET U="^"
DO DT^DICRW
FOR I=1:1
SET J=$PIECE($TEXT(T+I),";;",2)
if J']""
QUIT
WRITE !,J
+3 DO ^DGRPCS
if DGCONRUN
GOTO Q
SET Y=$SELECT($DATA(^DG(43,1,"CON")):$PIECE(^("CON"),"^",6),1:"")
IF +Y
XECUTE ^DD("DD")
WRITE !!,"LAST RUN COMPLETED: ",Y
OK WRITE !!,"Do you really want to update existing inconsistent entries"
SET %=2
DO YN^DICN
if %=2!(%=-1)
GOTO Q
+1 IF '%
WRITE !!?4,"Y - If you want me to run through all the entries currently filed in",!?9,"the INCONSISTENT DATA file and verify they're still inconsistent.",!?4,"N - If you wish to QUIT and rethink this action."
GOTO OK
+2 SET ION=""
SET DGPGM="ST^DGRPCU"
SET DGVAR="DUZ"
DO QUE^DGUTQ
SET IOP="HOME"
DO ^%ZIS
KILL IOP
Q KILL DFN,DGCONRUN,DGPGM,DGTIME,DGVAR,I,J,Y,%,%Y,PASS
DO CLOSE^DGUTQ
QUIT
+1 ; DG*5.3*653 BAJ Added call to Z07 Consistency checker
ST DO H^DGUTL
SET $PIECE(^DG(43,1,"CON"),"^",5)=DGTIME
FOR DFN=0:0
SET DFN=$ORDER(^DGIN(38.5,DFN))
if 'DFN
QUIT
DO EN^DGRPC
SET PASS=$$EN^IVMZ07C(DFN)
+1 DO H^DGUTL
SET $PIECE(^DG(43,1,"CON"),"^",6)=DGTIME
GOTO Q
T ;
+1 ;;This option is designed to loop through the existing entries in the INCONSISTENT
+2 ;;DATA file and verify that all elements are still inconsistent. This function
+3 ;;is necessary because some data may get updated by means where the consistency
+4 ;;checker isn't automatically run, i.e., VA FileMan. If you wish to in fact run
+5 ;;this option simply respond YES when asked and enter the DATE/TIME you wish the
+6 ;;option to commence running.
+7 ;
+8 ;
UPD ;update file 38.5 - called from DG CONSISTENCY CHECK option
+1 DO ON^DGRPC
if DGER
GOTO KVAR^DGRPCE
WRITE !!
SET DGEDIT=1
SET DIC="^DGIN(38.6,"
SET DIC(0)="AEQMZ"
SET DIC("S")="I Y'=21"
DO ^DIC
if Y'>0
GOTO KVAR^DGRPCE
SET DGD=+Y
+2 SET DGL=""
SET $PIECE(DGL,"=",80)=""
WRITE !,DGL
FOR I=0:0
SET I=$ORDER(^DGIN(38.6,+DGD,"D",I))
if 'I
QUIT
WRITE !,^(I,0)
+3 IF "^2^9^10^13^14^22^51^52^53^"[("^"_DGD_"^")
WRITE !!,*7,"This check can not be edited. It is automatically turned ",$SELECT(DGD=2:"OFF",DGD=51:"OFF",1:"ON"),"!",!,DGL
GOTO UPDQ
+4 WRITE !,DGL
SET (DA,Y)=DGD
SET DIE=DIC
SET DR="5;"
KILL DG,DQ
DO ^DIE
UPDQ KILL DA,DGD,DGEDIT,DGER,DGL,DR,DIC,DIE,I,X,Y
+1 GOTO UPD
