94 lines
3.3 KiB
Mathematica
94 lines
3.3 KiB
Mathematica
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
|