DGYMTRT1 ;ALB/CAW/LD - Print changed specialty report ; 9/8/94
;;5.3;Registration;**39**;Aug 13, 1993
;
; This routine will print the changed treating specialty report after
; completing the Specialty file (#42.4) and Facility Treating Specialty
; file (#45.7) update in routine DGYMTRT.
;
EN ; Print changed treating specialty report
D FTSP
W !!?2,"The following report will list all existing entries in the FACILITY TREATING",!?2,"SPECIALTY file (#45.7) that point to entries in the SPECIALTY file (#42.4)",!?2,"which have been changed."
S %ZIS="PMQ" D ^%ZIS K %ZIS G:POP ENQ
I '$D(IO("Q")) D PRINT,^%ZISC G ENQ
S Y=$$QUE
ENQ K DGTSP,POP,Y,ZTDESC,ZTRTN,ZTSAVE
Q
FTSP ; Facility Treating Specialty
N DGY
S DGY=0
F S DGY=$O(^DIC(45.7,DGY)) Q:'DGY I "^33^72^73^74^"[(U_$P(^(DGY,0),U,2)_U) S DGTSP(DGY)=""
Q
QUE() ; -- queue job
; return: did job queue [ 1|yes 0|no ]
;
K ZTSK,IO("Q")
S ZTDESC="Treating Specialty Report",ZTRTN="PRINT^DGYMTRT1"
S ZTSAVE("DGTSP(")=""
D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
Q $D(ZTSK)
PRINT ;Print any facility treating specialties that point to changed
;specialties.
;
U IO
S $P(DGDASH,"=",80)=""
W @IOF,!?24,"CHANGED TREATING SPECIALTY REPORT"
W !!,"FACILITY TREATING SPECIALTY (#45.7)",?45,"CHANGED SPECIALTY (#42.4)"
W !,DGDASH
N DGY,DGX S DGY=""
F S DGY=$O(DGTSP(DGY)) Q:'DGY S DGX=$G(^DIC(45.7,DGY,0)) D
.W !,$P(DGX,U),?45,$P($G(^DIC(42.4,$P(DGX,U,2),0)),U)
I '$D(DGTSP) W !!?2,"No entries found in File #45.7 which correspond to changed treating",!?2,"specialties in File #42.4."
K DGDASH
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGYMTRT1 1617 printed Sep 23, 2025@20:36:19 Page 2
DGYMTRT1 ;ALB/CAW/LD - Print changed specialty report ; 9/8/94
+1 ;;5.3;Registration;**39**;Aug 13, 1993
+2 ;
+3 ; This routine will print the changed treating specialty report after
+4 ; completing the Specialty file (#42.4) and Facility Treating Specialty
+5 ; file (#45.7) update in routine DGYMTRT.
+6 ;
EN ; Print changed treating specialty report
+1 DO FTSP
+2 WRITE !!?2,"The following report will list all existing entries in the FACILITY TREATING",!?2,"SPECIALTY file (#45.7) that point to entries in the SPECIALTY file (#42.4)",!?2,"which have been changed."
+3 SET %ZIS="PMQ"
DO ^%ZIS
KILL %ZIS
if POP
GOTO ENQ
+4 IF '$DATA(IO("Q"))
DO PRINT
DO ^%ZISC
GOTO ENQ
+5 SET Y=$$QUE
ENQ KILL DGTSP,POP,Y,ZTDESC,ZTRTN,ZTSAVE
+1 QUIT
FTSP ; Facility Treating Specialty
+1 NEW DGY
+2 SET DGY=0
+3 FOR
SET DGY=$ORDER(^DIC(45.7,DGY))
if 'DGY
QUIT
IF "^33^72^73^74^"[(U_$PIECE(^(DGY,0),U,2)_U)
SET DGTSP(DGY)=""
+4 QUIT
QUE() ; -- queue job
+1 ; return: did job queue [ 1|yes 0|no ]
+2 ;
+3 KILL ZTSK,IO("Q")
+4 SET ZTDESC="Treating Specialty Report"
SET ZTRTN="PRINT^DGYMTRT1"
+5 SET ZTSAVE("DGTSP(")=""
+6 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE " (Task: ",ZTSK,")"
+7 QUIT $DATA(ZTSK)
PRINT ;Print any facility treating specialties that point to changed
+1 ;specialties.
+2 ;
+3 USE IO
+4 SET $PIECE(DGDASH,"=",80)=""
+5 WRITE @IOF,!?24,"CHANGED TREATING SPECIALTY REPORT"
+6 WRITE !!,"FACILITY TREATING SPECIALTY (#45.7)",?45,"CHANGED SPECIALTY (#42.4)"
+7 WRITE !,DGDASH
+8 NEW DGY,DGX
SET DGY=""
+9 FOR
SET DGY=$ORDER(DGTSP(DGY))
if 'DGY
QUIT
SET DGX=$GET(^DIC(45.7,DGY,0))
Begin DoDot:1
+10 WRITE !,$PIECE(DGX,U),?45,$PIECE($GET(^DIC(42.4,$PIECE(DGX,U,2),0)),U)
End DoDot:1
+11 IF '$DATA(DGTSP)
WRITE !!?2,"No entries found in File #45.7 which correspond to changed treating",!?2,"specialties in File #42.4."
+12 KILL DGDASH
+13 QUIT
