source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYMTRT1.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1DGYMTRT1 ;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 ;
8EN ; 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
14ENQ K DGTSP,POP,Y,ZTDESC,ZTRTN,ZTSAVE
15 Q
16FTSP ; 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
21QUE() ; -- 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)
29PRINT ;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
Note: See TracBrowser for help on using the repository browser.