- 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 Feb 19, 2025@00:26:27 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