DGYVPST1 ;ALB/LD - Patch DG*5.3*64 Post-Init (cont.); 8/8/95
;;5.3;Registration;**64**;Aug 13, 1993
;
;
;
;
PRTERR ;--Print errors which occurred during pop of file #45.7 Eff Date mult
N DGPTE,DGPTM,DGPTMSG,DGPTS
S (DGPTM,DGPTS,DGPTE)=0
I $E(IOST,1,2)="C-" D HDR
F S DGPTM=$O(^TMP("DGPTERR",$J,DGPTM)) Q:'DGPTM!($G(DGPTEX)) D
.F S DGPTS=$O(^TMP("DGPTERR",$J,DGPTM,DGPTS)) Q:'DGPTS!($G(DGPTEX)) D
..F S DGPTE=$O(^TMP("DGPTERR",$J,DGPTM,DGPTS,DGPTE)) Q:'DGPTE!($G(DGPTEX)) D
...W !,"Specialty: ",$S($P($G(^DIC(42.4,DGPTM,0)),U)]"":$P($G(^DIC(42.4,DGPTM,0)),U),1:"UNKNOWN")
...W !,"Facility Treating Specialty: ",$S($P($G(^DIC(45.7,DGPTS,0)),U)]"":$P($G(^DIC(45.7,DGPTS,0)),U),1:"UNKNOWN")
...S DGPTMSG=$P($T(ERRMSG+DGPTE),";;",2)
...W !,DGPTMSG,!
...I $Y>(IOSL-5) D PAUSE Q:$G(DGPTEX) D HDR
K DGPTEX
Q
;
PAUSE ;--Pause for screen output
Q:$E(IOST,1,2)'="C-"
N XX,DIR,DIRUT,DUOUT
F XX=$Y:1:(IOSL-3) W !
S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S DGPTEX=1
Q
;
HDR ;--Screen header
W @IOF,?21,"Patch DG*5.3*64 Post-Init Report",!!
Q
;
ERRMSG ;--Error messages
;;Error with entry in file #42.4: Effective Date multiple zero node not found.
;;Error with entry in file #42.4: Incomplete Effective Date multiple zero node.
;;Error with entry in file #42.4: Missing Effective Date field in multiple.
;;Error with entry in file #45.7: Post-init terminated by user.
;;Effective Date multiple data already exists for this facility treating spec.
;
INACT ;-- Report of inactive facility treating specialties. These
;-- should be edited through the Treating Specialty Set-up option
;-- [DG TREATING SETUP] under the ADT System Definition Menu.
;
N DGFAC,DGI,DGJ,DGX,POP
W !!,">>> Creating Inactive Treating Specialty Report...",! H 2
F DGI=70,71,77 D
.F DGJ=0:0 S DGJ=$O(^DIC(45.7,"ASPEC",DGI,DGJ)) Q:'DGJ S DGFAC(DGJ)=DGI_"^"_$P($G(^DIC(45.7,DGJ,0)),U)
S %ZIS="MP" D ^%ZIS K %ZIS I POP Q
U IO
W @IOF,?23,"INACTIVE TREATING SPECIALTY REPORT",!
W !!?4,"The following facility treating specialties point to treating specialties",!?4,"which are now inactive. These facility treating specialties should be"
W !?4,"edited to point to active specialties through the Treating Specialty",!?4,"Set-up option [DG TREATING SETUP] under the ADT System Definition Menu.",!!
W !?8,"FACILITY TREATING SPECIALTY",?46,"INACTIVE TREATING SPECIALTY"
W !?8,"===========================",?46,"===========================",!
F DGX=0:0 S DGX=$O(DGFAC(DGX)) Q:'DGX W !?8,$P($G(DGFAC(DGX)),U,2),?46,$P($G(^DIC(42.4,$P($G(DGFAC(DGX)),U),0)),U)
I '$D(DGFAC) W !?4,"No inactive facility treating specialties found.",!
D ^%ZISC
INACTQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGYVPST1 2716 printed Apr 09, 2024@22:03:25 Page 2
DGYVPST1 ;ALB/LD - Patch DG*5.3*64 Post-Init (cont.); 8/8/95
+1 ;;5.3;Registration;**64**;Aug 13, 1993
+2 ;
+3 ;
+4 ;
+5 ;
PRTERR ;--Print errors which occurred during pop of file #45.7 Eff Date mult
+1 NEW DGPTE,DGPTM,DGPTMSG,DGPTS
+2 SET (DGPTM,DGPTS,DGPTE)=0
+3 IF $EXTRACT(IOST,1,2)="C-"
DO HDR
+4 FOR
SET DGPTM=$ORDER(^TMP("DGPTERR",$JOB,DGPTM))
if 'DGPTM!($GET(DGPTEX))
QUIT
Begin DoDot:1
+5 FOR
SET DGPTS=$ORDER(^TMP("DGPTERR",$JOB,DGPTM,DGPTS))
if 'DGPTS!($GET(DGPTEX))
QUIT
Begin DoDot:2
+6 FOR
SET DGPTE=$ORDER(^TMP("DGPTERR",$JOB,DGPTM,DGPTS,DGPTE))
if 'DGPTE!($GET(DGPTEX))
QUIT
Begin DoDot:3
+7 WRITE !,"Specialty: ",$SELECT($PIECE($GET(^DIC(42.4,DGPTM,0)),U)]"":$PIECE($GET(^DIC(42.4,DGPTM,0)),U),1:"UNKNOWN")
+8 WRITE !,"Facility Treating Specialty: ",$SELECT($PIECE($GET(^DIC(45.7,DGPTS,0)),U)]"":$PIECE($GET(^DIC(45.7,DGPTS,0)),U),1:"UNKNOWN")
+9 SET DGPTMSG=$PIECE($TEXT(ERRMSG+DGPTE),";;",2)
+10 WRITE !,DGPTMSG,!
+11 IF $Y>(IOSL-5)
DO PAUSE
if $GET(DGPTEX)
QUIT
DO HDR
End DoDot:3
End DoDot:2
End DoDot:1
+12 KILL DGPTEX
+13 QUIT
+14 ;
PAUSE ;--Pause for screen output
+1 if $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 NEW XX,DIR,DIRUT,DUOUT
+3 FOR XX=$Y:1:(IOSL-3)
WRITE !
+4 SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET DGPTEX=1
+5 QUIT
+6 ;
HDR ;--Screen header
+1 WRITE @IOF,?21,"Patch DG*5.3*64 Post-Init Report",!!
+2 QUIT
+3 ;
ERRMSG ;--Error messages
+1 ;;Error with entry in file #42.4: Effective Date multiple zero node not found.
+2 ;;Error with entry in file #42.4: Incomplete Effective Date multiple zero node.
+3 ;;Error with entry in file #42.4: Missing Effective Date field in multiple.
+4 ;;Error with entry in file #45.7: Post-init terminated by user.
+5 ;;Effective Date multiple data already exists for this facility treating spec.
+6 ;
INACT ;-- Report of inactive facility treating specialties. These
+1 ;-- should be edited through the Treating Specialty Set-up option
+2 ;-- [DG TREATING SETUP] under the ADT System Definition Menu.
+3 ;
+4 NEW DGFAC,DGI,DGJ,DGX,POP
+5 WRITE !!,">>> Creating Inactive Treating Specialty Report...",!
HANG 2
+6 FOR DGI=70,71,77
Begin DoDot:1
+7 FOR DGJ=0:0
SET DGJ=$ORDER(^DIC(45.7,"ASPEC",DGI,DGJ))
if 'DGJ
QUIT
SET DGFAC(DGJ)=DGI_"^"_$PIECE($GET(^DIC(45.7,DGJ,0)),U)
End DoDot:1
+8 SET %ZIS="MP"
DO ^%ZIS
KILL %ZIS
IF POP
QUIT
+9 USE IO
+10 WRITE @IOF,?23,"INACTIVE TREATING SPECIALTY REPORT",!
+11 WRITE !!?4,"The following facility treating specialties point to treating specialties",!?4,"which are now inactive. These facility treating specialties should be"
+12 WRITE !?4,"edited to point to active specialties through the Treating Specialty",!?4,"Set-up option [DG TREATING SETUP] under the ADT System Definition Menu.",!!
+13 WRITE !?8,"FACILITY TREATING SPECIALTY",?46,"INACTIVE TREATING SPECIALTY"
+14 WRITE !?8,"===========================",?46,"===========================",!
+15 FOR DGX=0:0
SET DGX=$ORDER(DGFAC(DGX))
if 'DGX
QUIT
WRITE !?8,$PIECE($GET(DGFAC(DGX)),U,2),?46,$PIECE($GET(^DIC(42.4,$PIECE($GET(DGFAC(DGX)),U),0)),U)
+16 IF '$DATA(DGFAC)
WRITE !?4,"No inactive facility treating specialties found.",!
+17 DO ^%ZISC
INACTQ QUIT
