DGYMTRT1.m

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 ---DGYMTRT1   1617     printed  Apr 09, 2024@22:03:01                                                                                                                                                                                                    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