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

PRSEPRG0.m

Go to the documentation of this file.
  1. PRSEPRG0 ;HINS/DAD-REVIEW GROUP MEMBERS REPORT ; 08/30/94 2:12 PM
  1. ;;4.0;PAID;;Sep 21, 1995
  1. S PRSESRV=$$EN3^PRSEUTL3(DUZ)
  1. S PRSEMISC=+$O(^PRSP(454.1,"B","MISCELLANEOUS",0))
  1. K DIC S DIC="^PRSE(452.3,",DIC(0)="AEMNQZ"
  1. S DIC("A")="Select REVIEW GROUP (Press RETURN for all): "
  1. S DIC("S")="S PRSE=$P(^(0),U,2) I (PRSESRV=PRSE)!(PRSEMISC=PRSE)!($$EN4^PRSEUTL3(DUZ))"
  1. W ! D ^DIC I $D(DTOUT)!$D(DUOUT) G EXIT
  1. S PRSEGRP=$S(Y>0:+Y,1:0),PRSEGRP("TX")=$G(Y(0,0))
  1. S ZTRTN="ENTSK^PRSEPRG0",(ZTSAVE("PRSEGRP"),ZTSAVE("PRSEGRP("))=""
  1. S (ZTSAVE("PRSESRV"),ZTSAVE("PRSEMISC"))=""
  1. S ZTDESC="Education Tracking REVIEW GROUP MEMBERS REPORT"
  1. K %ZIS,IOP D DEV^PRSEUTL G:POP!($D(ZTSK)) EXIT
  1. ENTSK ;
  1. K ^TMP($J,"PRSEPRG0")
  1. I PRSEGRP D
  1. . D LOOP
  1. . Q
  1. E D
  1. . S PRSEGRP=0
  1. . F S PRSEGRP=$O(^PRSE(452.3,PRSEGRP)) Q:PRSEGRP'>0 D LOOP
  1. . Q
  1. K PRSEUNDL S $P(PRSEUNDL,"-",81)=""
  1. S PRSEQUIT=0,PRSEPAGE=1,PRSENOW=$$FMTE^XLFDT($$DT^XLFDT())
  1. U IO D HEADER
  1. I $O(^TMP($J,"PRSEPRG0",""))="" D G EXIT
  1. . W !!,"No data found for this report."
  1. . I $G(PRSEGRP("TX"))]"" W !,"Review group: ",PRSEGRP("TX")
  1. . Q
  1. S PRSEGRP=""
  1. F S PRSEGRP=$O(^TMP($J,"PRSEPRG0",PRSEGRP)) Q:PRSEGRP=""!PRSEQUIT D
  1. . W !!,PRSEGRP
  1. . S PRSENAME=""
  1. . F S PRSENAME=$O(^TMP($J,"PRSEPRG0",PRSEGRP,PRSENAME)) Q:PRSENAME=""!PRSEQUIT D
  1. .. S Y="",Y=$G(^TMP($J,"PRSEPRG0",PRSEGRP,PRSENAME)) D:Y>0 DD^%DT W !?20,PRSENAME W:$G(Y)'="" ?50,Y
  1. .. I $Y>(IOSL-6) D PAUSE,HEADER
  1. .. Q
  1. . Q
  1. EXIT ;
  1. K ^TMP($J,"PRSEPRG0") S POUT=+$G(PRSEQUIT) D CLOSE^PRSEUTL,^PRSEKILL
  1. Q
  1. LOOP ;
  1. S X=$G(^PRSE(452.3,PRSEGRP,0))
  1. S PRSEGRP(0)=$P(X,U),PRSESERV=$P(X,U,2) Q:PRSEGRP(0)=""
  1. I (PRSESERV'=PRSESRV)&(PRSESERV'=PRSEMISC)&('$$EN4^PRSEUTL3(DUZ)) Q
  1. S PRSPCD0=0
  1. F S PRSPCD0=$O(^PRSPC("ARG",PRSEGRP,PRSPCD0)) Q:PRSPCD0'>0 D
  1. . S PRSEPD1=$O(^PRSPC("ARG",PRSEGRP,PRSPCD0,0)),PRSENAME=$P($G(^PRSPC(PRSPCD0,0)),U) Q:PRSENAME=""!($P($G(^PRSPC(PRSPCD0,1)),U,33)'="N")
  1. . S ^TMP($J,"PRSEPRG0",PRSEGRP(0),PRSENAME)=$P($G(^PRSPC(PRSPCD0,5,PRSEPD1,0)),U,2)
  1. . Q
  1. I $O(^TMP($J,"PRSEPRG0",PRSEGRP(0),""))="" D
  1. . S ^TMP($J,"PRSEPRG0",PRSEGRP(0),"NONE")=""
  1. . Q
  1. Q
  1. PAUSE ;
  1. I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S PRSEQUIT=$S(Y'>0:1,1:0)
  1. Q
  1. Q:PRSEQUIT
  1. W:($E(IOST)="C")!(PRSEPAGE>1) @IOF
  1. W !!?30,"REVIEW GROUP MEMBERS",?68,PRSENOW,!?68,"PAGE: ",PRSEPAGE
  1. S PRSEPAGE=PRSEPAGE+1
  1. W !,"REVIEW GROUP",?20,"GROUP MEMBER",?50,"DATE ASSIGNED",!,PRSEUNDL
  1. Q