source: WorldVistAEHR/trunk/r/PAID-PRS/PRSEUTL4.m@ 1464

PRSEUTL4 ;HISC/MD-CLASS ASSIGNMENT TO MANDATORY TRAINING GROUP ;2/22/94

 ;;4.0;PAID;**20**;Sep 21, 1995

EN1 ; ADD CLASS TO MANDATORY TRAINING GROUP FROM PRSEE-CLS-INF

 N DA,Y,X I '$D(^PRSE(452.3,"B")) W !?3,"MANDATORY TRAINING (MI) GROUP FILE NOT PRESENT CANNOT CONTINUE!",! Q

 S PRSW=0 F PDA=0:0 S PDA=$O(^PRSE(452.3,"C",PDA)) Q:PDA'>0  I $D(^PRSE(452.3,"C",PDA,PRSEMI)) W:'(+PRSW>0) !!,"This class is assigned to the following Mandatory Training Group(s): " W !,$P($G(^PRSE(452.3,PDA,0)),U) S PRSW=1

 I $G(PRSW) S DIR(0)="E" D ^DIR Q:$G(DIRUT)

 ; W @IOF,"This class may be assigned to the following Mandatory Training Gps."

 S:'+$P($G(^PRSE(452.1,+PRSEMI,0)),U,9) PRSW(1)=1 S PSPC=+$G(PRSESER) D DISP G:$G(POUT) QUIT

ADD F PDA=0:0 S PDA=$O(^TMP("PRSEGRP",$J,PDA)) Q:PDA'>0  D

 .   N DA,X,Y S X=$O(^PRSE(452.1,"B",PRSEPROG,0)),PRMI=$P($G(^PRSE(452.3,PDA,0)),U)

 .   S:'$D(^PRSE(452.3,PDA,1,0)) ^(0)="^452.31P^^"

 .   I $D(^PRSE(452.3,PDA,1,"B",X)) W !!,$C(7),"*** This class is already assigned to the "_PRMI_" training group. ***" Q

 .   K DD,DO I '$D(^PRSE(452.3,PDA,1,"B",X)) D

 .  .  S DA(1)=PDA,DLAYGO=452.31,DIC="^PRSE(452.3,DA(1),1,",DIC(0)="L" D FILE^DICN S DIK=DIC,DIK(1)=".01^B^C^D" D ENALL^DIK  K DIC,DIK D EN2^PRSEUTL5(PDA) W !!,"This class has been added to the "_PRMI_" MI review group."

 .  .  Q

 .  Q

 ; I '$G(POUT) W ! S DIR(0)="E" D ^DIR K DIR Q:Y'>0

QUIT K PRSETAB,PRSE,PRSEAQ,PRSEND,DIC,PURP,PSVC,DLAYGO,I,PRSEMAX,NCTR,PDA,PRMI,PRSECLA,PRSECNT,PRSEI,PRSEMI,PRSVC,PRSW,PRX

 Q

DISP ;

 K PRSETAB,PSVC S NCTR=1,PRSVC="",PRSEMAX=0

 F I=1:1 S PRSVC=$O(^PRSE(452.3,"B",PRSVC)) Q:PRSVC=""  F DA=0:0 S DA=$O(^PRSE(452.3,"B",PRSVC,DA)) Q:DA'>0  D  ;I $O(^PRSE(452.3,+DA,1,0))>0 D

 .   S HOSP=$O(^PRSP(454.1,"B","MISCELLANEOUS",0))

 .   I '($G(PRSESEL)="M"),(+$$EN4^PRSEUTL3($G(DUZ))!(DUZ(0)["@"!($P($G(^PRSE(452.3,+DA,0)),U,2)=PSPC!($P($G(^(0)),U,2)=HOSP!(+$G(PRSW(1))))))) D

 .   .   S PRSEMAX=PRSEMAX+1,PSVC(PRSEMAX)=DA_"^"_PRSVC

 .   .   Q

 .   I $G(PRSESEL)="M",$P($G(^PRSE(452.3,+DA,0)),U,2)=HOSP D

 .   .   S PRSEMAX=PRSEMAX+1,PSVC(PRSEMAX)=DA_"^"_PRSVC

 .   .   Q

 .   Q

 I '$O(PSVC(0)) W $C(7),!!,"No MANDATORY TRAINING GROUPS Found for this Service - NOTIFY PACKAGE COORDINATOR" S POUT=1 Q

 S PRSESTRT=1,(POUT,PRSEDONE)=0

 K ^TMP("PRSEGRP",$J) F  D DSP I $G(PRSEDONE)!$G(POUT) Q

 S:'$O(^TMP("PRSEGRP",$J,0)) POUT=1 Q

DSP ;

 W @IOF W:$D(PRSW) "This class may be assigned to the following mandatory Training Groups."  S PRSEAQ=$Y

 F PRSE=PRSESTRT:2:PRSEMAX S PRSEI=PRSE D  I $Y>(IOSL+PRSEAQ-5),PRSE'=PRSEMAX S PRSESTRT=PRSE+2 Q

 .  Q:$D(PSVC(PRSEI))[0

 .  S PRSEI(0)=PRSEI+1 W ! W:$G(PSVC(PRSEI))'="" ?1,$J(PRSEI,2),". ",$P($G(PSVC(PRSEI)),U,2) W:$G(PSVC(PRSEI(0)))'="" ?40,$J(PRSEI(0),2),". ",$P($G(PSVC(PRSEI(0))),U,2)

 .  Q

 S PRSEDONE=(PRSE=PRSEMAX)!(PRSE+1=PRSEMAX)

 I 'PRSEDONE W !,"<<More>>"

ASK W !!,"Select TRAINING Group(s) to be "_$S($G(PRSEACT)="D":"deleted: ",1:"assigned: ") R PRX:DTIME

 S:'$T PRX="^" I "^"[PRX S:$E(PRX)="^" POUT=1 Q

 S PRSENALL=1 D VALENT^PRSEED7 K PRSENALL I (PRX["?"!(PRSEBAD)) G DSP:PRX?2."?",ASK

 F PRSEI=1:1 S PRSECLA=$P(PRX,",",PRSEI) Q:PRSECLA=""  S PRSEND=$P(PRSECLA,"-",2)_"+"_PRSECLA F PRSECNT=+PRSECLA:1:PRSEND I +$G(PSVC(PRSECNT))>0 S ^TMP("PRSEGRP",$J,+PSVC(PRSECNT))=""

 Q

EN2(DA) ; USER SERVICE SELECTION ROUTINE WITH 200 FILE POINTER

 S (XXX,PDA,PRSEDATA)=""

 I $P($G(^PRSPC(DA,0)),U,9)?9N S PRSEDATA=$P(^(0),U,9)

 I PRSEDATA>0 S $P(PRSEDATA,U,2)=$P(^PRSPC(+DA,0),U,49) I $P(PRSEDATA,U,2)>0 S $P(PRSEDATA,U,3)=$O(^PRSP(454,1,"ORG","B",$E($P(PRSEDATA,U,2),1,4)_":"_$E($P(PRSEDATA,U,2),5,8),0))

 I +$P(PRSEDATA,U,3)>0 S $P(PRSEDATA,U,4)=+$P(^PRSP(454,1,"ORG",+$P(PRSEDATA,U,3),0),U,2),XXX=$P($G(^PRSP(454.1,+$P(PRSEDATA,U,4),0)),U)

 K PRSEDATA

 Q XXX