Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGYMTRT1

DGYMTRT1.m

Go to the documentation of this file.
  1. DGYMTRT1 ;ALB/CAW/LD - Print changed specialty report ; 9/8/94
  1. ;;5.3;Registration;**39**;Aug 13, 1993
  1. ;
  1. ; This routine will print the changed treating specialty report after
  1. ; completing the Specialty file (#42.4) and Facility Treating Specialty
  1. ; file (#45.7) update in routine DGYMTRT.
  1. ;
  1. EN ; Print changed treating specialty report
  1. D FTSP
  1. 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."
  1. S %ZIS="PMQ" D ^%ZIS K %ZIS G:POP ENQ
  1. I '$D(IO("Q")) D PRINT,^%ZISC G ENQ
  1. S Y=$$QUE
  1. ENQ K DGTSP,POP,Y,ZTDESC,ZTRTN,ZTSAVE
  1. Q
  1. FTSP ; Facility Treating Specialty
  1. N DGY
  1. S DGY=0
  1. 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)=""
  1. Q
  1. QUE() ; -- queue job
  1. ; return: did job queue [ 1|yes 0|no ]
  1. ;
  1. K ZTSK,IO("Q")
  1. S ZTDESC="Treating Specialty Report",ZTRTN="PRINT^DGYMTRT1"
  1. S ZTSAVE("DGTSP(")=""
  1. D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
  1. Q $D(ZTSK)
  1. PRINT ;Print any facility treating specialties that point to changed
  1. ;specialties.
  1. ;
  1. U IO
  1. S $P(DGDASH,"=",80)=""
  1. W @IOF,!?24,"CHANGED TREATING SPECIALTY REPORT"
  1. W !!,"FACILITY TREATING SPECIALTY (#45.7)",?45,"CHANGED SPECIALTY (#42.4)"
  1. W !,DGDASH
  1. N DGY,DGX S DGY=""
  1. F S DGY=$O(DGTSP(DGY)) Q:'DGY S DGX=$G(^DIC(45.7,DGY,0)) D
  1. .W !,$P(DGX,U),?45,$P($G(^DIC(42.4,$P(DGX,U,2),0)),U)
  1. I '$D(DGTSP) W !!?2,"No entries found in File #45.7 which correspond to changed treating",!?2,"specialties in File #42.4."
  1. K DGDASH
  1. Q