DG5385PT ;ALB/ABR -POST-INIT TS CLEANUP FOR PATCH 85 ; 4/10/96
;;5.3;Registration;**85**;Aug 13, 1993
;
;Variables:
; DGI = Division
; DGJ = Treating Specialty
; DGK = Census Date
; DGX = Kill flag
; DGY = # of days since previous TS census entry
;
POST ; entry point for post-install - set up checkpoints
N %
S %=$$NEWCP^XPDUTL("DGTSI","EN^DG5385PT",0) ; call-back routine for KIDS
S %=$$NEWCP^XPDUTL("DGTSJ"),%=$$NEWCP^XPDUTL("DGTSK")
Q
;
EN ;
N DGI,DGJ,DGK,DGK1,DGX,DGY,%
;
D BMES^XPDUTL(" >>Treating Specialty Census clean-up")
;
; retrieve values in checkpoints, step back for $O function
S DGI=+$$PARCP^XPDUTL("DGTSI"),DGJ=+$$PARCP^XPDUTL("DGTSJ"),DGK=+$$PARCP^XPDUTL("DGTSK")
I DGK,'+$G(^DG(40.8,DGI,"TS",DGJ,"C",DGK,0)) S DGK=DGK-.001
S:DGI DGI=DGI-.001 S:DGJ DGJ=DGJ-.001 ; if post-install has previously started, set DGI and DGJ back, so that $O will return values at time of failure
;
LOOP ; step thru division file, treating specialty census nodes to find problems
F S DGI=$O(^DG(40.8,DGI)) Q:'DGI S %=$$UPCP^XPDUTL("DGTSI",DGI) F S DGJ=+$O(^DG(40.8,DGI,"TS",+DGJ)),%=$$UPCP^XPDUTL("DGTSJ",DGJ) Q:'DGJ S DGX=1 D S DGK=0,%=$$UPCP^XPDUTL("DGTSK",DGK)
.S:'DGK DGK=+$O(^DG(40.8,DGI,"TS",+DGJ,"C",+DGK))
.F S DGK1=DGK,DGK=+$O(^DG(40.8,DGI,"TS",+DGJ,"C",+DGK)),%=$$UPCP^XPDUTL("DGTSK",DGK) S DGY=$$DTCK(DGK,DGK1) Q:DGY=1 D I DGX D FLG
..I 'DGY S $P(^DG(40.8,DGI,"TS",DGJ,"C",DGK,0),U)=DGK,^DG(40.8,DGI,"TS",DGJ,"C","B",DGK,DGK)=""
..; update DGK ckpt after file is updated, so $O finds next node to be considered.
Q
;
FLG ;kills 0 x-refs
K ^DG(40.8,DGI,"TS",DGJ,"C","B",0) S DGX=0
Q
;
DTCK(X1,X2) ; checks for 2 sequential dates
N X
; X1 = current date being checked (DGK)
; X2 = previous date checked (DGK1)
S X=0
I 'X1 S X=1 G Q
I +$G(^DG(40.8,DGI,"TS",DGJ,"C",DGK,0))=DGK D ^%DTC
Q Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG5385PT 1901 printed Dec 13, 2024@02:39:06 Page 2
DG5385PT ;ALB/ABR -POST-INIT TS CLEANUP FOR PATCH 85 ; 4/10/96
+1 ;;5.3;Registration;**85**;Aug 13, 1993
+2 ;
+3 ;Variables:
+4 ; DGI = Division
+5 ; DGJ = Treating Specialty
+6 ; DGK = Census Date
+7 ; DGX = Kill flag
+8 ; DGY = # of days since previous TS census entry
+9 ;
POST ; entry point for post-install - set up checkpoints
+1 NEW %
+2 ; call-back routine for KIDS
SET %=$$NEWCP^XPDUTL("DGTSI","EN^DG5385PT",0)
+3 SET %=$$NEWCP^XPDUTL("DGTSJ")
SET %=$$NEWCP^XPDUTL("DGTSK")
+4 QUIT
+5 ;
EN ;
+1 NEW DGI,DGJ,DGK,DGK1,DGX,DGY,%
+2 ;
+3 DO BMES^XPDUTL(" >>Treating Specialty Census clean-up")
+4 ;
+5 ; retrieve values in checkpoints, step back for $O function
+6 SET DGI=+$$PARCP^XPDUTL("DGTSI")
SET DGJ=+$$PARCP^XPDUTL("DGTSJ")
SET DGK=+$$PARCP^XPDUTL("DGTSK")
+7 IF DGK
IF '+$GET(^DG(40.8,DGI,"TS",DGJ,"C",DGK,0))
SET DGK=DGK-.001
+8 ; if post-install has previously started, set DGI and DGJ back, so that $O will return values at time of failure
if DGI
SET DGI=DGI-.001
if DGJ
SET DGJ=DGJ-.001
+9 ;
LOOP ; step thru division file, treating specialty census nodes to find problems
+1 FOR
SET DGI=$ORDER(^DG(40.8,DGI))
if 'DGI
QUIT
SET %=$$UPCP^XPDUTL("DGTSI",DGI)
FOR
SET DGJ=+$ORDER(^DG(40.8,DGI,"TS",+DGJ))
SET %=$$UPCP^XPDUTL("DGTSJ",DGJ)
if 'DGJ
QUIT
SET DGX=1
Begin DoDot:1
+2 if 'DGK
SET DGK=+$ORDER(^DG(40.8,DGI,"TS",+DGJ,"C",+DGK))
+3 FOR
SET DGK1=DGK
SET DGK=+$ORDER(^DG(40.8,DGI,"TS",+DGJ,"C",+DGK))
SET %=$$UPCP^XPDUTL("DGTSK",DGK)
SET DGY=$$DTCK(DGK,DGK1)
if DGY=1
QUIT
Begin DoDot:2
+4 IF 'DGY
SET $PIECE(^DG(40.8,DGI,"TS",DGJ,"C",DGK,0),U)=DGK
SET ^DG(40.8,DGI,"TS",DGJ,"C","B",DGK,DGK)=""
+5 ; update DGK ckpt after file is updated, so $O finds next node to be considered.
End DoDot:2
IF DGX
DO FLG
End DoDot:1
SET DGK=0
SET %=$$UPCP^XPDUTL("DGTSK",DGK)
+6 QUIT
+7 ;
FLG ;kills 0 x-refs
+1 KILL ^DG(40.8,DGI,"TS",DGJ,"C","B",0)
SET DGX=0
+2 QUIT
+3 ;
DTCK(X1,X2) ; checks for 2 sequential dates
+1 NEW X
+2 ; X1 = current date being checked (DGK)
+3 ; X2 = previous date checked (DGK1)
+4 SET X=0
+5 IF 'X1
SET X=1
GOTO Q
+6 IF +$GET(^DG(40.8,DGI,"TS",DGJ,"C",DGK,0))=DGK
DO ^%DTC
Q QUIT X
