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 Nov 22, 2024@17:36:59 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
