- PRSEUTL5 ;HISC/DAD-UPDATE MANDATORY CLASS MULT FROM MI REVIEW GROUP MULT ;3/23/94
- ;;4.0;PAID;;Sep 21, 1995
- EN1(PRSED0) ; PRSED0 = IEN of an entry in file #450
- ; Update MANDATORY CLASS multiple for an individual
- N D0,D1,DA,DD,DIC,DIDEL,DIE,DIK,DINUM,DLAYGO,DO,DR
- N PRSE,PRSECD0,PRSECLAS,PRSECNT,PRSED1,PRSEDTAS,PRSEGD0,PRSEGD1,X,Y
- S PRSED1=0
- F S PRSED1=$O(^PRSPC(PRSED0,5,PRSED1)) Q:PRSED1'>0 D
- . S PRSE=$G(^PRSPC(PRSED0,5,PRSED1,0))
- . S PRSEGD0=+$P(PRSE,"^"),PRSEDTAS=$P(PRSE,"^",2) Q:PRSEGD0'>0
- . S PRSEGD1=0
- . F S PRSEGD1=$O(^PRSE(452.3,PRSEGD0,1,PRSEGD1)) Q:PRSEGD1'>0 D
- .. S PRSECD0=+$P($G(^PRSE(452.3,PRSEGD0,1,PRSEGD1,0)),"^") Q:PRSECD0'>0
- .. S $P(PRSECLAS(PRSECD0),"^")=PRSEDTAS
- .. S $P(PRSECLAS(PRSECD0),"^",2)=$P(PRSECLAS(PRSECD0),"^",2)+1
- .. Q
- . Q
- D UPDATE
- Q
- ;
- EN2(PRSEGD0) ; PRSEGD0 = IEN of an entry in file #452.3
- ; Update MANDATORY CLASS multiple for ALL individuals
- ; with a selected MI REVIEW GROUP (*** TASKED ***)
- N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- S ZTRTN="EN21^PRSEUTL5",ZTSAVE("PRSEGD0")="",ZTDTH=$H,ZTIO=""
- S ZTDESC="Education Tracking MANDATORY CLASS multiple update"
- D ^%ZTLOAD
- Q
- EN21 S PRSED0=0
- F S PRSED0=$O(^PRSPC("ARG",PRSEGD0,PRSED0)) Q:PRSED0'>0 D EN1(PRSED0)
- K PRSED0,PRSEGD0 S:$D(ZTQUEUED) ZTREQ="@"
- Q
- ;
- UPDATE S PRSED1=0
- F S PRSED1=$O(^PRSPC(PRSED0,6,PRSED1)) Q:PRSED1'>0 D
- . S PRSE=$G(^PRSPC(PRSED0,6,PRSED1,0))
- . S PRSECD0=+$P(PRSE,"^"),PRSECNT=+$P(PRSE,"^",2) Q:PRSECD0'>0
- . S PRSE=$G(PRSECLAS(PRSECD0))
- . S PRSEDTAS=$P(PRSE,"^"),PRSECNT(0)=+$P(PRSE,"^",2)
- . I PRSECNT=0,PRSECNT(0)=0 Q ; *** One-shot class
- . I PRSECNT(0) D ; *** Update class count
- .. K D0,D1,DA,DIE,DR S DIE="^PRSPC("_PRSED0_",6,"
- .. S DR=".02///"_PRSECNT(0)_$S(PRSEDTAS:";.03///"_PRSEDTAS,1:"")
- .. S (D0,DA(1))=PRSED0,(D1,DA)=PRSED1
- .. I PRSECNT'=PRSECNT(0) D ^DIE
- .. Q
- . E D ; *** Delete class
- .. K D0,D1,DA,DIK S DIK="^PRSPC("_PRSED0_",6,",DIDEL=450
- .. S (D0,DA(1))=PRSED0,(D1,DA)=PRSED1 D ^DIK
- .. Q
- . K PRSECLAS(PRSECD0)
- . Q
- S PRSECD0=0 ; *** Add class
- F S PRSECD0=$O(PRSECLAS(PRSECD0)) Q:PRSECD0'>0 D
- . S PRSE=$G(PRSECLAS(PRSECD0))
- . S PRSEDTAS=$P(PRSE,"^"),PRSECNT(0)=+$P(PRSE,"^",2) Q:PRSECNT(0)'>0
- . K DD,DIC,DINUM,DO
- . S DIC="^PRSPC("_PRSED0_",6,",DIC(0)="L",DLAYGO=450,X=PRSECD0
- . S DIC("P")=$P(^DD(450,633,0),"^",2),(D0,DA(1))=PRSED0
- . D FILE^DICN S PRSED1=+Y
- . K D0,D1,DA,DIE,DR
- . S DIE="^PRSPC("_PRSED0_",6,"
- . S DR=".02///"_PRSECNT(0)_$S(PRSEDTAS:";.03///"_PRSEDTAS,1:"")
- . S (D0,DA(1))=PRSED0,(D1,DA)=PRSED1 D ^DIE
- . Q
- K PRSECLAS
- Q
- ;
- EN3(PRSEGD0) ; PRSEGD0 = IEN in file 452.3
- ; Used by ^DD(452.3,.01,"DEL",1,0) = "I $$EN3^PRSEUTL5(D0)"
- I $O(^PRSPC("ARG",PRSEGD0,0)) D
- . D EN^DDIOL(" This review group has employees assigned to it !!")
- . Q
- Q 0
- ;
- EN4(PRSEGD0) ; PRSEGD0 = IEN in file #452.3
- ; Used to delete review groups from individuals when the
- ; review group itself is deleted. (*** TASKED ***)
- S ZTRTN="EN41^PRSEUTL5",ZTSAVE("PRSEGD0")="",ZTDTH=$H,ZTIO=""
- S ZTDESC="Education Tracking update MI REVIEW GROUP mult." D ^%ZTLOAD
- Q
- ;
- EN41 S PRSED0=0
- F S PRSED0=$O(^PRSPC("ARG",PRSEGD0,PRSED0)) Q:PRSED0'>0 D
- . S PRSED1=0
- . F S PRSED1=$O(^PRSPC("ARG",PRSEGD0,PRSED0,PRSED1)) Q:PRSED1'>0 D
- .. I $P($G(^PRSPC(PRSED0,5,PRSED1,0)),"^")'=PRSEGD0 Q
- .. S DIK="^PRSPC("_PRSED0_",5,",(D0,DA(1))=PRSED0,(D1,DA)=PRSED1
- .. D ^DIK
- .. Q
- . Q
- S:$D(ZTQUEUED) ZTREQ="@"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEUTL5 3474 printed Feb 18, 2025@23:53:27 Page 2
- PRSEUTL5 ;HISC/DAD-UPDATE MANDATORY CLASS MULT FROM MI REVIEW GROUP MULT ;3/23/94
- +1 ;;4.0;PAID;;Sep 21, 1995
- EN1(PRSED0) ; PRSED0 = IEN of an entry in file #450
- +1 ; Update MANDATORY CLASS multiple for an individual
- +2 NEW D0,D1,DA,DD,DIC,DIDEL,DIE,DIK,DINUM,DLAYGO,DO,DR
- +3 NEW PRSE,PRSECD0,PRSECLAS,PRSECNT,PRSED1,PRSEDTAS,PRSEGD0,PRSEGD1,X,Y
- +4 SET PRSED1=0
- +5 FOR
- SET PRSED1=$ORDER(^PRSPC(PRSED0,5,PRSED1))
- if PRSED1'>0
- QUIT
- Begin DoDot:1
- +6 SET PRSE=$GET(^PRSPC(PRSED0,5,PRSED1,0))
- +7 SET PRSEGD0=+$PIECE(PRSE,"^")
- SET PRSEDTAS=$PIECE(PRSE,"^",2)
- if PRSEGD0'>0
- QUIT
- +8 SET PRSEGD1=0
- +9 FOR
- SET PRSEGD1=$ORDER(^PRSE(452.3,PRSEGD0,1,PRSEGD1))
- if PRSEGD1'>0
- QUIT
- Begin DoDot:2
- +10 SET PRSECD0=+$PIECE($GET(^PRSE(452.3,PRSEGD0,1,PRSEGD1,0)),"^")
- if PRSECD0'>0
- QUIT
- +11 SET $PIECE(PRSECLAS(PRSECD0),"^")=PRSEDTAS
- +12 SET $PIECE(PRSECLAS(PRSECD0),"^",2)=$PIECE(PRSECLAS(PRSECD0),"^",2)+1
- +13 QUIT
- End DoDot:2
- +14 QUIT
- End DoDot:1
- +15 DO UPDATE
- +16 QUIT
- +17 ;
- EN2(PRSEGD0) ; PRSEGD0 = IEN of an entry in file #452.3
- +1 ; Update MANDATORY CLASS multiple for ALL individuals
- +2 ; with a selected MI REVIEW GROUP (*** TASKED ***)
- +3 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
- +4 SET ZTRTN="EN21^PRSEUTL5"
- SET ZTSAVE("PRSEGD0")=""
- SET ZTDTH=$HOROLOG
- SET ZTIO=""
- +5 SET ZTDESC="Education Tracking MANDATORY CLASS multiple update"
- +6 DO ^%ZTLOAD
- +7 QUIT
- EN21 SET PRSED0=0
- +1 FOR
- SET PRSED0=$ORDER(^PRSPC("ARG",PRSEGD0,PRSED0))
- if PRSED0'>0
- QUIT
- DO EN1(PRSED0)
- +2 KILL PRSED0,PRSEGD0
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 QUIT
- +4 ;
- UPDATE SET PRSED1=0
- +1 FOR
- SET PRSED1=$ORDER(^PRSPC(PRSED0,6,PRSED1))
- if PRSED1'>0
- QUIT
- Begin DoDot:1
- +2 SET PRSE=$GET(^PRSPC(PRSED0,6,PRSED1,0))
- +3 SET PRSECD0=+$PIECE(PRSE,"^")
- SET PRSECNT=+$PIECE(PRSE,"^",2)
- if PRSECD0'>0
- QUIT
- +4 SET PRSE=$GET(PRSECLAS(PRSECD0))
- +5 SET PRSEDTAS=$PIECE(PRSE,"^")
- SET PRSECNT(0)=+$PIECE(PRSE,"^",2)
- +6 ; *** One-shot class
- IF PRSECNT=0
- IF PRSECNT(0)=0
- QUIT
- +7 ; *** Update class count
- IF PRSECNT(0)
- Begin DoDot:2
- +8 KILL D0,D1,DA,DIE,DR
- SET DIE="^PRSPC("_PRSED0_",6,"
- +9 SET DR=".02///"_PRSECNT(0)_$SELECT(PRSEDTAS:";.03///"_PRSEDTAS,1:"")
- +10 SET (D0,DA(1))=PRSED0
- SET (D1,DA)=PRSED1
- +11 IF PRSECNT'=PRSECNT(0)
- DO ^DIE
- +12 QUIT
- End DoDot:2
- +13 ; *** Delete class
- IF '$TEST
- Begin DoDot:2
- +14 KILL D0,D1,DA,DIK
- SET DIK="^PRSPC("_PRSED0_",6,"
- SET DIDEL=450
- +15 SET (D0,DA(1))=PRSED0
- SET (D1,DA)=PRSED1
- DO ^DIK
- +16 QUIT
- End DoDot:2
- +17 KILL PRSECLAS(PRSECD0)
- +18 QUIT
- End DoDot:1
- +19 ; *** Add class
- SET PRSECD0=0
- +20 FOR
- SET PRSECD0=$ORDER(PRSECLAS(PRSECD0))
- if PRSECD0'>0
- QUIT
- Begin DoDot:1
- +21 SET PRSE=$GET(PRSECLAS(PRSECD0))
- +22 SET PRSEDTAS=$PIECE(PRSE,"^")
- SET PRSECNT(0)=+$PIECE(PRSE,"^",2)
- if PRSECNT(0)'>0
- QUIT
- +23 KILL DD,DIC,DINUM,DO
- +24 SET DIC="^PRSPC("_PRSED0_",6,"
- SET DIC(0)="L"
- SET DLAYGO=450
- SET X=PRSECD0
- +25 SET DIC("P")=$PIECE(^DD(450,633,0),"^",2)
- SET (D0,DA(1))=PRSED0
- +26 DO FILE^DICN
- SET PRSED1=+Y
- +27 KILL D0,D1,DA,DIE,DR
- +28 SET DIE="^PRSPC("_PRSED0_",6,"
- +29 SET DR=".02///"_PRSECNT(0)_$SELECT(PRSEDTAS:";.03///"_PRSEDTAS,1:"")
- +30 SET (D0,DA(1))=PRSED0
- SET (D1,DA)=PRSED1
- DO ^DIE
- +31 QUIT
- End DoDot:1
- +32 KILL PRSECLAS
- +33 QUIT
- +34 ;
- EN3(PRSEGD0) ; PRSEGD0 = IEN in file 452.3
- +1 ; Used by ^DD(452.3,.01,"DEL",1,0) = "I $$EN3^PRSEUTL5(D0)"
- +2 IF $ORDER(^PRSPC("ARG",PRSEGD0,0))
- Begin DoDot:1
- +3 DO EN^DDIOL(" This review group has employees assigned to it !!")
- +4 QUIT
- End DoDot:1
- +5 QUIT 0
- +6 ;
- EN4(PRSEGD0) ; PRSEGD0 = IEN in file #452.3
- +1 ; Used to delete review groups from individuals when the
- +2 ; review group itself is deleted. (*** TASKED ***)
- +3 SET ZTRTN="EN41^PRSEUTL5"
- SET ZTSAVE("PRSEGD0")=""
- SET ZTDTH=$HOROLOG
- SET ZTIO=""
- +4 SET ZTDESC="Education Tracking update MI REVIEW GROUP mult."
- DO ^%ZTLOAD
- +5 QUIT
- +6 ;
- EN41 SET PRSED0=0
- +1 FOR
- SET PRSED0=$ORDER(^PRSPC("ARG",PRSEGD0,PRSED0))
- if PRSED0'>0
- QUIT
- Begin DoDot:1
- +2 SET PRSED1=0
- +3 FOR
- SET PRSED1=$ORDER(^PRSPC("ARG",PRSEGD0,PRSED0,PRSED1))
- if PRSED1'>0
- QUIT
- Begin DoDot:2
- +4 IF $PIECE($GET(^PRSPC(PRSED0,5,PRSED1,0)),"^")'=PRSEGD0
- QUIT
- +5 SET DIK="^PRSPC("_PRSED0_",5,"
- SET (D0,DA(1))=PRSED0
- SET (D1,DA)=PRSED1
- +6 DO ^DIK
- +7 QUIT
- End DoDot:2
- +8 QUIT
- End DoDot:1
- +9 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +10 QUIT