- 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 Feb 18, 2025@23:53:20 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