PRSEPRG0 ;HINS/DAD-REVIEW GROUP MEMBERS REPORT ; 08/30/94 2:12 PM
;;4.0;PAID;;Sep 21, 1995
S PRSESRV=$$EN3^PRSEUTL3(DUZ)
S PRSEMISC=+$O(^PRSP(454.1,"B","MISCELLANEOUS",0))
K DIC S DIC="^PRSE(452.3,",DIC(0)="AEMNQZ"
S DIC("A")="Select REVIEW GROUP (Press RETURN for all): "
S DIC("S")="S PRSE=$P(^(0),U,2) I (PRSESRV=PRSE)!(PRSEMISC=PRSE)!($$EN4^PRSEUTL3(DUZ))"
W ! D ^DIC I $D(DTOUT)!$D(DUOUT) G EXIT
S PRSEGRP=$S(Y>0:+Y,1:0),PRSEGRP("TX")=$G(Y(0,0))
S ZTRTN="ENTSK^PRSEPRG0",(ZTSAVE("PRSEGRP"),ZTSAVE("PRSEGRP("))=""
S (ZTSAVE("PRSESRV"),ZTSAVE("PRSEMISC"))=""
S ZTDESC="Education Tracking REVIEW GROUP MEMBERS REPORT"
K %ZIS,IOP D DEV^PRSEUTL G:POP!($D(ZTSK)) EXIT
ENTSK ;
K ^TMP($J,"PRSEPRG0")
I PRSEGRP D
. D LOOP
. Q
E D
. S PRSEGRP=0
. F S PRSEGRP=$O(^PRSE(452.3,PRSEGRP)) Q:PRSEGRP'>0 D LOOP
. Q
K PRSEUNDL S $P(PRSEUNDL,"-",81)=""
S PRSEQUIT=0,PRSEPAGE=1,PRSENOW=$$FMTE^XLFDT($$DT^XLFDT())
U IO D HEADER
I $O(^TMP($J,"PRSEPRG0",""))="" D G EXIT
. W !!,"No data found for this report."
. I $G(PRSEGRP("TX"))]"" W !,"Review group: ",PRSEGRP("TX")
. Q
S PRSEGRP=""
F S PRSEGRP=$O(^TMP($J,"PRSEPRG0",PRSEGRP)) Q:PRSEGRP=""!PRSEQUIT D
. W !!,PRSEGRP
. S PRSENAME=""
. F S PRSENAME=$O(^TMP($J,"PRSEPRG0",PRSEGRP,PRSENAME)) Q:PRSENAME=""!PRSEQUIT D
.. S Y="",Y=$G(^TMP($J,"PRSEPRG0",PRSEGRP,PRSENAME)) D:Y>0 DD^%DT W !?20,PRSENAME W:$G(Y)'="" ?50,Y
.. I $Y>(IOSL-6) D PAUSE,HEADER
.. Q
. Q
EXIT ;
K ^TMP($J,"PRSEPRG0") S POUT=+$G(PRSEQUIT) D CLOSE^PRSEUTL,^PRSEKILL
Q
LOOP ;
S X=$G(^PRSE(452.3,PRSEGRP,0))
S PRSEGRP(0)=$P(X,U),PRSESERV=$P(X,U,2) Q:PRSEGRP(0)=""
I (PRSESERV'=PRSESRV)&(PRSESERV'=PRSEMISC)&('$$EN4^PRSEUTL3(DUZ)) Q
S PRSPCD0=0
F S PRSPCD0=$O(^PRSPC("ARG",PRSEGRP,PRSPCD0)) Q:PRSPCD0'>0 D
. 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")
. S ^TMP($J,"PRSEPRG0",PRSEGRP(0),PRSENAME)=$P($G(^PRSPC(PRSPCD0,5,PRSEPD1,0)),U,2)
. Q
I $O(^TMP($J,"PRSEPRG0",PRSEGRP(0),""))="" D
. S ^TMP($J,"PRSEPRG0",PRSEGRP(0),"NONE")=""
. Q
Q
PAUSE ;
I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S PRSEQUIT=$S(Y'>0:1,1:0)
Q
Q:PRSEQUIT
W:($E(IOST)="C")!(PRSEPAGE>1) @IOF
W !!?30,"REVIEW GROUP MEMBERS",?68,PRSENOW,!?68,"PAGE: ",PRSEPAGE
S PRSEPAGE=PRSEPAGE+1
W !,"REVIEW GROUP",?20,"GROUP MEMBER",?50,"DATE ASSIGNED",!,PRSEUNDL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEPRG0 2449 printed Apr 09, 2024@21:29:28 Page 2
PRSEPRG0 ;HINS/DAD-REVIEW GROUP MEMBERS REPORT ; 08/30/94 2:12 PM
+1 ;;4.0;PAID;;Sep 21, 1995
+2 SET PRSESRV=$$EN3^PRSEUTL3(DUZ)
+3 SET PRSEMISC=+$ORDER(^PRSP(454.1,"B","MISCELLANEOUS",0))
+4 KILL DIC
SET DIC="^PRSE(452.3,"
SET DIC(0)="AEMNQZ"
+5 SET DIC("A")="Select REVIEW GROUP (Press RETURN for all): "
+6 SET DIC("S")="S PRSE=$P(^(0),U,2) I (PRSESRV=PRSE)!(PRSEMISC=PRSE)!($$EN4^PRSEUTL3(DUZ))"
+7 WRITE !
DO ^DIC
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
+8 SET PRSEGRP=$SELECT(Y>0:+Y,1:0)
SET PRSEGRP("TX")=$GET(Y(0,0))
+9 SET ZTRTN="ENTSK^PRSEPRG0"
SET (ZTSAVE("PRSEGRP"),ZTSAVE("PRSEGRP("))=""
+10 SET (ZTSAVE("PRSESRV"),ZTSAVE("PRSEMISC"))=""
+11 SET ZTDESC="Education Tracking REVIEW GROUP MEMBERS REPORT"
+12 KILL %ZIS,IOP
DO DEV^PRSEUTL
if POP!($DATA(ZTSK))
GOTO EXIT
ENTSK ;
+1 KILL ^TMP($JOB,"PRSEPRG0")
+2 IF PRSEGRP
Begin DoDot:1
+3 DO LOOP
+4 QUIT
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET PRSEGRP=0
+7 FOR
SET PRSEGRP=$ORDER(^PRSE(452.3,PRSEGRP))
if PRSEGRP'>0
QUIT
DO LOOP
+8 QUIT
End DoDot:1
+9 KILL PRSEUNDL
SET $PIECE(PRSEUNDL,"-",81)=""
+10 SET PRSEQUIT=0
SET PRSEPAGE=1
SET PRSENOW=$$FMTE^XLFDT($$DT^XLFDT())
+11 USE IO
DO HEADER
+12 IF $ORDER(^TMP($JOB,"PRSEPRG0",""))=""
Begin DoDot:1
+13 WRITE !!,"No data found for this report."
+14 IF $GET(PRSEGRP("TX"))]""
WRITE !,"Review group: ",PRSEGRP("TX")
+15 QUIT
End DoDot:1
GOTO EXIT
+16 SET PRSEGRP=""
+17 FOR
SET PRSEGRP=$ORDER(^TMP($JOB,"PRSEPRG0",PRSEGRP))
if PRSEGRP=""!PRSEQUIT
QUIT
Begin DoDot:1
+18 WRITE !!,PRSEGRP
+19 SET PRSENAME=""
+20 FOR
SET PRSENAME=$ORDER(^TMP($JOB,"PRSEPRG0",PRSEGRP,PRSENAME))
if PRSENAME=""!PRSEQUIT
QUIT
Begin DoDot:2
+21 SET Y=""
SET Y=$GET(^TMP($JOB,"PRSEPRG0",PRSEGRP,PRSENAME))
if Y>0
DO DD^%DT
WRITE !?20,PRSENAME
if $GET(Y)'=""
WRITE ?50,Y
+22 IF $Y>(IOSL-6)
DO PAUSE
DO HEADER
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
EXIT ;
+1 KILL ^TMP($JOB,"PRSEPRG0")
SET POUT=+$GET(PRSEQUIT)
DO CLOSE^PRSEUTL
DO ^PRSEKILL
+2 QUIT
LOOP ;
+1 SET X=$GET(^PRSE(452.3,PRSEGRP,0))
+2 SET PRSEGRP(0)=$PIECE(X,U)
SET PRSESERV=$PIECE(X,U,2)
if PRSEGRP(0)=""
QUIT
+3 IF (PRSESERV'=PRSESRV)&(PRSESERV'=PRSEMISC)&('$$EN4^PRSEUTL3(DUZ))
QUIT
+4 SET PRSPCD0=0
+5 FOR
SET PRSPCD0=$ORDER(^PRSPC("ARG",PRSEGRP,PRSPCD0))
if PRSPCD0'>0
QUIT
Begin DoDot:1
+6 SET PRSEPD1=$ORDER(^PRSPC("ARG",PRSEGRP,PRSPCD0,0))
SET PRSENAME=$PIECE($GET(^PRSPC(PRSPCD0,0)),U)
if PRSENAME=""!($PIECE($GET(^PRSPC(PRSPCD0,1)),U,33)'="N")
QUIT
+7 SET ^TMP($JOB,"PRSEPRG0",PRSEGRP(0),PRSENAME)=$PIECE($GET(^PRSPC(PRSPCD0,5,PRSEPD1,0)),U,2)
+8 QUIT
End DoDot:1
+9 IF $ORDER(^TMP($JOB,"PRSEPRG0",PRSEGRP(0),""))=""
Begin DoDot:1
+10 SET ^TMP($JOB,"PRSEPRG0",PRSEGRP(0),"NONE")=""
+11 QUIT
End DoDot:1
+12 QUIT
PAUSE ;
+1 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET PRSEQUIT=$SELECT(Y'>0:1,1:0)
+2 QUIT
+1 if PRSEQUIT
QUIT
+2 if ($EXTRACT(IOST)="C")!(PRSEPAGE>1)
WRITE @IOF
+3 WRITE !!?30,"REVIEW GROUP MEMBERS",?68,PRSENOW,!?68,"PAGE: ",PRSEPAGE
+4 SET PRSEPAGE=PRSEPAGE+1
+5 WRITE !,"REVIEW GROUP",?20,"GROUP MEMBER",?50,"DATE ASSIGNED",!,PRSEUNDL
+6 QUIT
