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

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