| 1 | DGYMTRT1 ;ALB/CAW/LD - Print changed specialty report ; 9/8/94
|
|---|
| 2 | ;;5.3;Registration;**39**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine will print the changed treating specialty report after
|
|---|
| 5 | ; completing the Specialty file (#42.4) and Facility Treating Specialty
|
|---|
| 6 | ; file (#45.7) update in routine DGYMTRT.
|
|---|
| 7 | ;
|
|---|
| 8 | EN ; Print changed treating specialty report
|
|---|
| 9 | D FTSP
|
|---|
| 10 | 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."
|
|---|
| 11 | S %ZIS="PMQ" D ^%ZIS K %ZIS G:POP ENQ
|
|---|
| 12 | I '$D(IO("Q")) D PRINT,^%ZISC G ENQ
|
|---|
| 13 | S Y=$$QUE
|
|---|
| 14 | ENQ K DGTSP,POP,Y,ZTDESC,ZTRTN,ZTSAVE
|
|---|
| 15 | Q
|
|---|
| 16 | FTSP ; Facility Treating Specialty
|
|---|
| 17 | N DGY
|
|---|
| 18 | S DGY=0
|
|---|
| 19 | 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)=""
|
|---|
| 20 | Q
|
|---|
| 21 | QUE() ; -- queue job
|
|---|
| 22 | ; return: did job queue [ 1|yes 0|no ]
|
|---|
| 23 | ;
|
|---|
| 24 | K ZTSK,IO("Q")
|
|---|
| 25 | S ZTDESC="Treating Specialty Report",ZTRTN="PRINT^DGYMTRT1"
|
|---|
| 26 | S ZTSAVE("DGTSP(")=""
|
|---|
| 27 | D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
|
|---|
| 28 | Q $D(ZTSK)
|
|---|
| 29 | PRINT ;Print any facility treating specialties that point to changed
|
|---|
| 30 | ;specialties.
|
|---|
| 31 | ;
|
|---|
| 32 | U IO
|
|---|
| 33 | S $P(DGDASH,"=",80)=""
|
|---|
| 34 | W @IOF,!?24,"CHANGED TREATING SPECIALTY REPORT"
|
|---|
| 35 | W !!,"FACILITY TREATING SPECIALTY (#45.7)",?45,"CHANGED SPECIALTY (#42.4)"
|
|---|
| 36 | W !,DGDASH
|
|---|
| 37 | N DGY,DGX S DGY=""
|
|---|
| 38 | F S DGY=$O(DGTSP(DGY)) Q:'DGY S DGX=$G(^DIC(45.7,DGY,0)) D
|
|---|
| 39 | .W !,$P(DGX,U),?45,$P($G(^DIC(42.4,$P(DGX,U,2),0)),U)
|
|---|
| 40 | I '$D(DGTSP) W !!?2,"No entries found in File #45.7 which correspond to changed treating",!?2,"specialties in File #42.4."
|
|---|
| 41 | K DGDASH
|
|---|
| 42 | Q
|
|---|
