- 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 Jan 18, 2025@03:56:49 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