DGYVPOST ;ALB/LD - Patch DG*5.3*64 Post-Init ; 8/8/95
;;5.3;Registration;**64**;Aug 13, 1993
;
;
;-- Populate FACILITY TREATING SPECIALTY file (#45.7) with effective
;-- date and active flag from pointed to Effective Date multiple
;-- entries in the TREATING SPECIALTY file (#42.4).
;
EN ;-- Entry point
;
N DGPTQ
D XREFCHK
I $G(DGPTQ) D DONE
I '$G(DGPTQ) D RXREF,POPMUL,ERRPT,INACT^DGYVPST1,DONE
ENQ Q
;
XREFCHK ;-- Check for "ASPEC" xref in ^DD(45.7
;
W !!,">>> This post-init will populate the Effective Date multiple of each record",!?4,"in the Facility Treating Specialty file (#45.7).",!!
N I S (DGPTQ,I)=0,I=$O(^DD(45.7,0,"IX","ASPEC",45.7,I))
I '$G(I) S DGPTQ=1
I $G(I) I '$D(^DD(45.7,"IX",I)) S DGPTQ=1
I $G(DGPTQ) W !,"***ERROR: Cross reference ""ASPEC"" in file #45.7 not found.",!?10,"Rerun init DGYVINIT from patch DG*5.3*64 (see patch description",!?10,"for complete instructions).",!
Q
;
RXREF ;--Reindex Specialty (#1) field "ASPEC" xref in file 45.7
;
N DIK
S DIK="^DIC(45.7,",DIK(1)="1" D ENALL^DIK
Q
;
POPMUL ;--Get data from file 42.4 to populate eff date mult in file 45.7
;
W !!,">>> Post-Init started at: " D NOW^%DTC W $$FTIME^VALM1(%),!
;
N DGPTERR,DGPTMIEN,DGPTOUT,DGPTSIEN,DIRUT,DTOUT,DUOUT
F DGPTMIEN=0:0 S DGPTMIEN=$O(^DIC(45.7,"ASPEC",DGPTMIEN)) Q:'DGPTMIEN!($G(DGPTOUT)) D
.F DGPTSIEN=0:0 S DGPTSIEN=$O(^DIC(45.7,"ASPEC",DGPTMIEN,DGPTSIEN)) Q:'DGPTSIEN!($G(DGPTOUT)) D
..N DGPTASK,DGPTEFF,DGPTCTR,DGPTI
..;--Subentry doesn't exist in file 42.4
..I '$D(^DIC(42.4,DGPTMIEN,"E",0)) S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,1)="" Q
..;--Get total # of subentries from file 42.4 subfile header node
..S DGPTCTR=$P($G(^DIC(42.4,DGPTMIEN,"E",0)),U,4) I DGPTCTR'>0 S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,2)="" Q
..F DGPTI=1:1:DGPTCTR Q:$G(DGPTOUT)!($G(DGPTEFF)=0) D POPFAC
POPMULQ Q
;
POPFAC ;--Populate eff date mult in FTS file #45.7
N DGPTACTF,DGPTEFDT,DGPTNODE,DA,DIC,DIE,DINUM,DR,X,Y
;--Get effective date and active flag from file 42.4 subentry
S DGPTNODE=$G(^DIC(42.4,DGPTMIEN,"E",DGPTI,0)) I DGPTNODE']"" S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,3)="" G POPFACQ
I (DGPTMIEN=70!(DGPTMIEN=71)!(DGPTMIEN=77)),('$G(DGPTASK)) D ASK
I $D(DIRUT)!$D(DUOUT)!$D(DTOUT) S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,4)="",DGPTOUT=1 G POPFACQ
I $G(DGPTEFF)=0 S DGPTCTR=1 ;if no to inactivate, add active eff date only
S DGPTEFDT=$P(DGPTNODE,U),DGPTACTF=$P(DGPTNODE,U,2)
;--Add fields to file 45.7 subentry
S DIC="^DIC(45.7,"_DGPTSIEN_",""E"","
S DIC(0)="L"
S (DA,DINUM)=DGPTI
S X=DGPTEFDT
;--Extra variables needed since it's a multiple
S DIC("P")=$P(^DD(45.7,100,0),"^",2)
S DA(1)=DGPTSIEN
;--Create/edit subentry
S DIC("DR")=".02///^S X="_DGPTACTF
K DD,DO D FILE^DICN
I $G(Y)=-1 S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,5)=""
I $G(DTOUT)!($G(DUOUT)) S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,4)="",DGPTOUT=1 G POPFACQ
;--Write msg (once) to screen while processing
I $G(Y)>0,($G(DGPTI)<2) W !!,"... Added ",$S('$G(DGPTEFF):"active ",1:"inactive "),"effective date and ",$S('$G(DGPTEFF):"active ",1:"inactive "),"flag to facility",!?4,"treating specialty ",$P($G(^DIC(45.7,DGPTSIEN,0)),U)
;
POPFACQ Q
ASK ;
W !! S DIR("A")=" Inactivate facility treating specialty"
S DIR("A",1)=" Facility treating specialty, "_$P($G(^DIC(45.7,DGPTSIEN,0)),U)_","
S DIR("A",2)=" is pointing to an inactive treating specialty in the Specialty (#42.4)"
S DIR("A",3)=" file. Answering 'Yes' to this prompt will make the facility treating"
S DIR("A",4)=" specialty inactive also."
S DIR("A",5)=" "
S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR S (DGPTASK,DGPTEFF)=+Y K Y
W !
ASKQ Q
;
ERRPT ;--Queue error report for printing or print direct
Q:'$D(^TMP("DGPTERR",$J))
;
W !!,">>> The following report will list all messages and/or errors which occurred",!?4,"while running this post-init.",!
N POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK
S %ZIS="QMP" D ^%ZIS K %ZIS I POP Q
I '$D(IO("Q")) U IO D PRTERR^DGYVPST1,^%ZISC G ERRPTQ
; task job
S ZTRTN="PRTERR^DGYVPST1",ZTSAVE("^TMP(""DGPTERR"",$J,")=""
S ZTDESC="Patch DG*5.3*64 Post-Init Error Report"
D ^%ZTLOAD
W !!,$S($D(ZTSK):">>> Job has been queued. The task number is "_ZTSK_".",1:">>> Unable to queue this job.")
ERRPTQ K IO("Q"),^TMP("DGPTERR",$J)
Q
;
DONE W !!,">>> Post-Init completed at: " D NOW^%DTC W $$FTIME^VALM1(%),!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGYVPOST 4476 printed Apr 09, 2024@21:53:10 Page 2
DGYVPOST ;ALB/LD - Patch DG*5.3*64 Post-Init ; 8/8/95
+1 ;;5.3;Registration;**64**;Aug 13, 1993
+2 ;
+3 ;
+4 ;-- Populate FACILITY TREATING SPECIALTY file (#45.7) with effective
+5 ;-- date and active flag from pointed to Effective Date multiple
+6 ;-- entries in the TREATING SPECIALTY file (#42.4).
+7 ;
EN ;-- Entry point
+1 ;
+2 NEW DGPTQ
+3 DO XREFCHK
+4 IF $GET(DGPTQ)
DO DONE
+5 IF '$GET(DGPTQ)
DO RXREF
DO POPMUL
DO ERRPT
DO INACT^DGYVPST1
DO DONE
ENQ QUIT
+1 ;
XREFCHK ;-- Check for "ASPEC" xref in ^DD(45.7
+1 ;
+2 WRITE !!,">>> This post-init will populate the Effective Date multiple of each record",!?4,"in the Facility Treating Specialty file (#45.7).",!!
+3 NEW I
SET (DGPTQ,I)=0
SET I=$ORDER(^DD(45.7,0,"IX","ASPEC",45.7,I))
+4 IF '$GET(I)
SET DGPTQ=1
+5 IF $GET(I)
IF '$DATA(^DD(45.7,"IX",I))
SET DGPTQ=1
+6 IF $GET(DGPTQ)
WRITE !,"***ERROR: Cross reference ""ASPEC"" in file #45.7 not found.",!?10,"Rerun init DGYVINIT from patch DG*5.3*64 (see patch description",!?10,"for complete instructions).",!
+7 QUIT
+8 ;
RXREF ;--Reindex Specialty (#1) field "ASPEC" xref in file 45.7
+1 ;
+2 NEW DIK
+3 SET DIK="^DIC(45.7,"
SET DIK(1)="1"
DO ENALL^DIK
+4 QUIT
+5 ;
POPMUL ;--Get data from file 42.4 to populate eff date mult in file 45.7
+1 ;
+2 WRITE !!,">>> Post-Init started at: "
DO NOW^%DTC
WRITE $$FTIME^VALM1(%),!
+3 ;
+4 NEW DGPTERR,DGPTMIEN,DGPTOUT,DGPTSIEN,DIRUT,DTOUT,DUOUT
+5 FOR DGPTMIEN=0:0
SET DGPTMIEN=$ORDER(^DIC(45.7,"ASPEC",DGPTMIEN))
if 'DGPTMIEN!($GET(DGPTOUT))
QUIT
Begin DoDot:1
+6 FOR DGPTSIEN=0:0
SET DGPTSIEN=$ORDER(^DIC(45.7,"ASPEC",DGPTMIEN,DGPTSIEN))
if 'DGPTSIEN!($GET(DGPTOUT))
QUIT
Begin DoDot:2
+7 NEW DGPTASK,DGPTEFF,DGPTCTR,DGPTI
+8 ;--Subentry doesn't exist in file 42.4
+9 IF '$DATA(^DIC(42.4,DGPTMIEN,"E",0))
SET ^TMP("DGPTERR",$JOB,DGPTMIEN,DGPTSIEN,1)=""
QUIT
+10 ;--Get total # of subentries from file 42.4 subfile header node
+11 SET DGPTCTR=$PIECE($GET(^DIC(42.4,DGPTMIEN,"E",0)),U,4)
IF DGPTCTR'>0
SET ^TMP("DGPTERR",$JOB,DGPTMIEN,DGPTSIEN,2)=""
QUIT
+12 FOR DGPTI=1:1:DGPTCTR
if $GET(DGPTOUT)!($GET(DGPTEFF)=0)
QUIT
DO POPFAC
End DoDot:2
End DoDot:1
POPMULQ QUIT
+1 ;
POPFAC ;--Populate eff date mult in FTS file #45.7
+1 NEW DGPTACTF,DGPTEFDT,DGPTNODE,DA,DIC,DIE,DINUM,DR,X,Y
+2 ;--Get effective date and active flag from file 42.4 subentry
+3 SET DGPTNODE=$GET(^DIC(42.4,DGPTMIEN,"E",DGPTI,0))
IF DGPTNODE']""
SET ^TMP("DGPTERR",$JOB,DGPTMIEN,DGPTSIEN,3)=""
GOTO POPFACQ
+4 IF (DGPTMIEN=70!(DGPTMIEN=71)!(DGPTMIEN=77))
IF ('$GET(DGPTASK))
DO ASK
+5 IF $DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)
SET ^TMP("DGPTERR",$JOB,DGPTMIEN,DGPTSIEN,4)=""
SET DGPTOUT=1
GOTO POPFACQ
+6 ;if no to inactivate, add active eff date only
IF $GET(DGPTEFF)=0
SET DGPTCTR=1
+7 SET DGPTEFDT=$PIECE(DGPTNODE,U)
SET DGPTACTF=$PIECE(DGPTNODE,U,2)
+8 ;--Add fields to file 45.7 subentry
+9 SET DIC="^DIC(45.7,"_DGPTSIEN_",""E"","
+10 SET DIC(0)="L"
+11 SET (DA,DINUM)=DGPTI
+12 SET X=DGPTEFDT
+13 ;--Extra variables needed since it's a multiple
+14 SET DIC("P")=$PIECE(^DD(45.7,100,0),"^",2)
+15 SET DA(1)=DGPTSIEN
+16 ;--Create/edit subentry
+17 SET DIC("DR")=".02///^S X="_DGPTACTF
+18 KILL DD,DO
DO FILE^DICN
+19 IF $GET(Y)=-1
SET ^TMP("DGPTERR",$JOB,DGPTMIEN,DGPTSIEN,5)=""
+20 IF $GET(DTOUT)!($GET(DUOUT))
SET ^TMP("DGPTERR",$JOB,DGPTMIEN,DGPTSIEN,4)=""
SET DGPTOUT=1
GOTO POPFACQ
+21 ;--Write msg (once) to screen while processing
+22 IF $GET(Y)>0
IF ($GET(DGPTI)<2)
WRITE !!,"... Added ",$SELECT('$GET(DGPTEFF):"active ",1:"inactive "),"effective date and ",$SELECT('$GET(DGPTEFF):"active ",1:"inactive "),"flag to facility",!?4,"treating specialty ",$PIECE($GET(^DIC(45.7,DGPTSIEN,0)),U)
+23 ;
POPFACQ QUIT
ASK ;
+1 WRITE !!
SET DIR("A")=" Inactivate facility treating specialty"
+2 SET DIR("A",1)=" Facility treating specialty, "_$PIECE($GET(^DIC(45.7,DGPTSIEN,0)),U)_","
+3 SET DIR("A",2)=" is pointing to an inactive treating specialty in the Specialty (#42.4)"
+4 SET DIR("A",3)=" file. Answering 'Yes' to this prompt will make the facility treating"
+5 SET DIR("A",4)=" specialty inactive also."
+6 SET DIR("A",5)=" "
+7 SET DIR(0)="Y"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
SET (DGPTASK,DGPTEFF)=+Y
KILL Y
+8 WRITE !
ASKQ QUIT
+1 ;
ERRPT ;--Queue error report for printing or print direct
+1 if '$DATA(^TMP("DGPTERR",$JOB))
QUIT
+2 ;
+3 WRITE !!,">>> The following report will list all messages and/or errors which occurred",!?4,"while running this post-init.",!
+4 NEW POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+5 SET %ZIS="QMP"
DO ^%ZIS
KILL %ZIS
IF POP
QUIT
+6 IF '$DATA(IO("Q"))
USE IO
DO PRTERR^DGYVPST1
DO ^%ZISC
GOTO ERRPTQ
+7 ; task job
+8 SET ZTRTN="PRTERR^DGYVPST1"
SET ZTSAVE("^TMP(""DGPTERR"",$J,")=""
+9 SET ZTDESC="Patch DG*5.3*64 Post-Init Error Report"
+10 DO ^%ZTLOAD
+11 WRITE !!,$SELECT($DATA(ZTSK):">>> Job has been queued. The task number is "_ZTSK_".",1:">>> Unable to queue this job.")
ERRPTQ KILL IO("Q"),^TMP("DGPTERR",$JOB)
+1 QUIT
+2 ;
DONE WRITE !!,">>> Post-Init completed at: "
DO NOW^%DTC
WRITE $$FTIME^VALM1(%),!
+1 QUIT
+2 ;
