PRSEDEL1 ;HISC/MD-EDIT DELETE STUDENT RECORD ;07/14/94
;;4.0;PAID;;Sep 21, 1995
EN1 ; ENTRY FROM OPTION PRSEE-I-EMP
S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
S (NOUT,NSW)=0 D EN2^PRSEUTL3($G(DUZ)) I PRSESER=""&'(DUZ(0)="@") D MSG3^PRSEMSG G Q1
S DIR(0)="SO^M:Mandatory Training (MI);C:Continuing Education;O:Other/Miscellaneous;W:Ward/Unit-Location Training;A:All",DIR("A")="Select a Training Type" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) G Q1
S PRSESEL=Y,(PRSENAM,PRSEDT)=""
CLS F K POUT S Y=-1 R !!,"Select TRAINING CLASS: ",X:DTIME S:'$T X="^^" S:X="" Y="" Q:"^^"[X D Q:Y]""
. S DIC("S")="S DATA=$G(^PRSE(452,Y,0)),PRSEIEN=$G(^PRSE(452,""AK"",$P($G(DATA),U,2),Y)) I PRSESEL=""A""!($P(DATA,U,21)=PRSESEL),(PRSEIEN=$G(PRSESER)!(DUZ(0)[""@""!(+$$EN4^PRSEUTL3($G(DUZ)))))"
. S DIC("W")="W ?($X+4),$$DICW^PRSEDEL1(^(0))"
. S DLAYGO=452,DIC=452,DIC(0)=$E("SZE",1,(X'=" ")+2),D="AK" D IX^DIC K DIC I X?1"?".E!(Y>0) W:X=" " " ",$P(Y(0),U,2) S Y=$S(Y>0:$P(Y(0),U,2),1:"") Q
. I X=" ",'(+Y>0)!($L(X)<2) S POUT=1 Q
. I '(+Y>0) W !!?3,$C(7),"'"_X_"' IS NOT CURRENTLY IN THE STUDENT TRACKING #452 FILE" S (X,Y)="",POUT=1 Q
G Q1:Y=""!(Y<0)!($D(POUT)) S PRSENAM=Y K Y
S PRSEDA(1)=$O(^PRSE(452,"AK",PRSENAM,0)),PRSEDATA=$G(^PRSE(452,+PRSEDA(1),0)),PRSEDATA(2)=$G(^PRSE(452,+PRSEDA(1),6)),PRSELEN=$P($G(PRSEDATA),U,16),PRSETYP=$P($G(PRSEDATA),U,21),PRSENTR=$P($G(PRSEDATA(2)),U,2)
S PRSEDATA(1)=PRSENAM_"^"_PRSELEN_"^"_PRSETYP_"^"_PRSENTR
S DIR(0)="FAO^3:53",DIR("A")="TRAINING CLASS: " S:'(PRSENAM="") DIR("B")=PRSENAM D ^DIR K DIR G:$D(DTOUT)!($D(DUOUT)) Q1 S PRSEX=Y
I "@"[X W !!,$C(7),"ARE YOU SURE YOU WANT TO DELETE ALL RECORDS FOR THIS CLASS/DATE" S %=2,PRSEX=X D YN^DICN G:'(%=1) EN1 G:%=1 LOOP
S DA=PRSEDA(1) D SUPPR^PRSEED12 Q:$G(POUT)=1
S DIR(0)="SO^M:Mandatory Training (MI);C:Continuing Education;O:Other/Miscellaneous;W:Ward/Unit-Location Training",DIR("A")="Select a Training Type"
S:'(PRSETYP="") DIR("B")=$S(PRSETYP="M":"Mandatory Training (MI)",PRSETYP="C":"Continuing Education",PRSETYP="O":"Other/Miscellaneous",PRSETYP="W":"Ward/Unit-Location Training",1:"")
D ^DIR K DIR G:$D(DTOUT)!($D(DUOUT)) Q1
S PRSETYP=Y
S DIR(0)="NAO^0:9999.99:2",DIR("?")="Type a Number between 0 and 9999.99, 2 Decimal Digits",DIR("A")="PRSE PROGRAM/CLASS LENGTH HRS: " S:+PRSELEN DIR("B")=PRSELEN D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) G Q1
S PRSELEN=Y,PRSEDATA(2)=PRSEX_"^"_PRSELEN_"^"_PRSETYP_"^"_PRSENTR G:PRSEDATA(1)=PRSEDATA(2) CLS
LOOP ;
W ! F PRSEDA(1)=0:0 S PRSEDA(1)=$O(^PRSE(452,"CLS",PRSENAM,PRSEDA(1))) Q:PRSEDA(1)'>0 W "." D
. I PRSEX="@" S DIK="^PRSE(452,",DA=PRSEDA(1) D ^DIK Q
. S DIE="^PRSE(452,",DA=PRSEDA(1),DR="1////"_PRSEX_";5////"_PRSETYP_";2.1////"_PRSELEN_";2.4////"_PRSENTR_"" D ^DIE
. Q
S (PRSECLS,DA)=+$O(^PRSE(452.1,"B",PRSENAM,0)) I DA>0 D
. I PRSEX="@" S DIK="^PRSE(452.1," D ^DIK Q
. S DIE="^PRSE(452.1,",DR=".01///"_PRSEX_";2///"_PRSELEN_";5///"_PRSETYP_"" D ^DIE K DIE
. Q
S DA=$O(^PRSE(452.8,"B",PRSECLS,0)) I DA>0 D
. I PRSEX="@" S DIK="^PRSE(452.8," D ^DIK Q
. S DIE="^PRSE(452.8,",DR="4////"_$P($G(PRSEDATA(2)),U,3)_";15////"_$P($G(PRSEDATA(2)),U,2)_";7.1///"_$J($P($G(PRSEDATA(2)),U,2),1,0)_"" D ^DIE K DIE,DR
. S DA(1)=DA F DA=0:0 S DA=$O(^PRSE(452.8,DA(1),3,DA)) Q:DA'>0 I $G(^PRSE(452.8,DA(1),3,DA,0))'="" S DIE="^PRSE(452.8,DA(1),3,",DR="3///"_$P($G(PRSEDATA(2)),U,4)_"" D ^DIE
. Q
G CLS
Q1 D ^PRSEKILL
Q
DICW(CLASS) ;
N CLASSTXT,CLASSIEN,CLASSERV
S CLASSTXT=$P($G(CLASS),U,2) S:CLASSTXT="" CLASSTXT=U
S CLASSIEN=+$O(^PRSE(452.1,"B",CLASSTXT,0))
S CLASSERV(0)=$$SERV(+$P($G(^PRSE(452.1,CLASSIEN,0)),U,8))
I CLASSERV(0)="" D
. S CLASSERV=+$O(^PRSE(452,"AK",CLASSTXT,0)),CLASSERV=+$G(^(CLASSERV))
. S CLASSERV(0)=$$SERV(CLASSERV)
. Q
Q $S(CLASSERV(0)]"":CLASSERV(0),1:"UNKNOWN")
SERV(Y) Q $P($G(^PRSP(454.1,+$G(Y),0)),U)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEDEL1 3875 printed Dec 13, 2024@02:26:20 Page 2
PRSEDEL1 ;HISC/MD-EDIT DELETE STUDENT RECORD ;07/14/94
+1 ;;4.0;PAID;;Sep 21, 1995
EN1 ; ENTRY FROM OPTION PRSEE-I-EMP
+1 SET X=$GET(^PRSE(452.7,1,"OFF"))
IF X=""!(X=1)
DO MSG6^PRSEMSG
QUIT
+2 SET (NOUT,NSW)=0
DO EN2^PRSEUTL3($GET(DUZ))
IF PRSESER=""&'(DUZ(0)="@")
DO MSG3^PRSEMSG
GOTO Q1
+3 SET DIR(0)="SO^M:Mandatory Training (MI);C:Continuing Education;O:Other/Miscellaneous;W:Ward/Unit-Location Training;A:All"
SET DIR("A")="Select a Training Type"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO Q1
+4 SET PRSESEL=Y
SET (PRSENAM,PRSEDT)=""
CLS FOR
KILL POUT
SET Y=-1
READ !!,"Select TRAINING CLASS: ",X:DTIME
if '$TEST
SET X="^^"
if X=""
SET Y=""
if "^^"[X
QUIT
Begin DoDot:1
+1 SET DIC("S")="S DATA=$G(^PRSE(452,Y,0)),PRSEIEN=$G(^PRSE(452,""AK"",$P($G(DATA),U,2),Y)) I PRSESEL=""A""!($P(DATA,U,21)=PRSESEL),(PRSEIEN=$G(PRSESER)!(DUZ(0)[""@""!(+$$EN4^PRSEUTL3($G(DUZ)))))"
+2 SET DIC("W")="W ?($X+4),$$DICW^PRSEDEL1(^(0))"
+3 SET DLAYGO=452
SET DIC=452
SET DIC(0)=$EXTRACT("SZE",1,(X'=" ")+2)
SET D="AK"
DO IX^DIC
KILL DIC
IF X?1"?".E!(Y>0)
if X=" "
WRITE " ",$PIECE(Y(0),U,2)
SET Y=$SELECT(Y>0:$PIECE(Y(0),U,2),1:"")
QUIT
+4 IF X=" "
IF '(+Y>0)!($LENGTH(X)<2)
SET POUT=1
QUIT
+5 IF '(+Y>0)
WRITE !!?3,$CHAR(7),"'"_X_"' IS NOT CURRENTLY IN THE STUDENT TRACKING #452 FILE"
SET (X,Y)=""
SET POUT=1
QUIT
End DoDot:1
if Y]""
QUIT
+6 if Y=""!(Y<0)!($DATA(POUT))
GOTO Q1
SET PRSENAM=Y
KILL Y
+7 SET PRSEDA(1)=$ORDER(^PRSE(452,"AK",PRSENAM,0))
SET PRSEDATA=$GET(^PRSE(452,+PRSEDA(1),0))
SET PRSEDATA(2)=$GET(^PRSE(452,+PRSEDA(1),6))
SET PRSELEN=$PIECE($GET(PRSEDATA),U,16)
SET PRSETYP=$PIECE($GET(PRSEDATA),U,21)
SET PRSENTR=$PIECE($GET(PRSEDATA(2)),U,2)
+8 SET PRSEDATA(1)=PRSENAM_"^"_PRSELEN_"^"_PRSETYP_"^"_PRSENTR
+9 SET DIR(0)="FAO^3:53"
SET DIR("A")="TRAINING CLASS: "
if '(PRSENAM="")
SET DIR("B")=PRSENAM
DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO Q1
SET PRSEX=Y
+10 IF "@"[X
WRITE !!,$CHAR(7),"ARE YOU SURE YOU WANT TO DELETE ALL RECORDS FOR THIS CLASS/DATE"
SET %=2
SET PRSEX=X
DO YN^DICN
if '(%=1)
GOTO EN1
if %=1
GOTO LOOP
+11 SET DA=PRSEDA(1)
DO SUPPR^PRSEED12
if $GET(POUT)=1
QUIT
+12 SET DIR(0)="SO^M:Mandatory Training (MI);C:Continuing Education;O:Other/Miscellaneous;W:Ward/Unit-Location Training"
SET DIR("A")="Select a Training Type"
+13 if '(PRSETYP="")
SET DIR("B")=$SELECT(PRSETYP="M":"Mandatory Training (MI)",PRSETYP="C":"Continuing Education",PRSETYP="O":"Other/Miscellaneous",PRSETYP="W":"Ward/Unit-Location Training",1:"")
+14 DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO Q1
+15 SET PRSETYP=Y
+16 SET DIR(0)="NAO^0:9999.99:2"
SET DIR("?")="Type a Number between 0 and 9999.99, 2 Decimal Digits"
SET DIR("A")="PRSE PROGRAM/CLASS LENGTH HRS: "
if +PRSELEN
SET DIR("B")=PRSELEN
DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO Q1
+17 SET PRSELEN=Y
SET PRSEDATA(2)=PRSEX_"^"_PRSELEN_"^"_PRSETYP_"^"_PRSENTR
if PRSEDATA(1)=PRSEDATA(2)
GOTO CLS
LOOP ;
+1 WRITE !
FOR PRSEDA(1)=0:0
SET PRSEDA(1)=$ORDER(^PRSE(452,"CLS",PRSENAM,PRSEDA(1)))
if PRSEDA(1)'>0
QUIT
WRITE "."
Begin DoDot:1
+2 IF PRSEX="@"
SET DIK="^PRSE(452,"
SET DA=PRSEDA(1)
DO ^DIK
QUIT
+3 SET DIE="^PRSE(452,"
SET DA=PRSEDA(1)
SET DR="1////"_PRSEX_";5////"_PRSETYP_";2.1////"_PRSELEN_";2.4////"_PRSENTR_""
DO ^DIE
+4 QUIT
End DoDot:1
+5 SET (PRSECLS,DA)=+$ORDER(^PRSE(452.1,"B",PRSENAM,0))
IF DA>0
Begin DoDot:1
+6 IF PRSEX="@"
SET DIK="^PRSE(452.1,"
DO ^DIK
QUIT
+7 SET DIE="^PRSE(452.1,"
SET DR=".01///"_PRSEX_";2///"_PRSELEN_";5///"_PRSETYP_""
DO ^DIE
KILL DIE
+8 QUIT
End DoDot:1
+9 SET DA=$ORDER(^PRSE(452.8,"B",PRSECLS,0))
IF DA>0
Begin DoDot:1
+10 IF PRSEX="@"
SET DIK="^PRSE(452.8,"
DO ^DIK
QUIT
+11 SET DIE="^PRSE(452.8,"
SET DR="4////"_$PIECE($GET(PRSEDATA(2)),U,3)_";15////"_$PIECE($GET(PRSEDATA(2)),U,2)_";7.1///"_$JUSTIFY($PIECE($GET(PRSEDATA(2)),U,2),1,0)_""
DO ^DIE
KILL DIE,DR
+12 SET DA(1)=DA
FOR DA=0:0
SET DA=$ORDER(^PRSE(452.8,DA(1),3,DA))
if DA'>0
QUIT
IF $GET(^PRSE(452.8,DA(1),3,DA,0))'=""
SET DIE="^PRSE(452.8,DA(1),3,"
SET DR="3///"_$PIECE($GET(PRSEDATA(2)),U,4)_""
DO ^DIE
+13 QUIT
End DoDot:1
+14 GOTO CLS
Q1 DO ^PRSEKILL
+1 QUIT
DICW(CLASS) ;
+1 NEW CLASSTXT,CLASSIEN,CLASSERV
+2 SET CLASSTXT=$PIECE($GET(CLASS),U,2)
if CLASSTXT=""
SET CLASSTXT=U
+3 SET CLASSIEN=+$ORDER(^PRSE(452.1,"B",CLASSTXT,0))
+4 SET CLASSERV(0)=$$SERV(+$PIECE($GET(^PRSE(452.1,CLASSIEN,0)),U,8))
+5 IF CLASSERV(0)=""
Begin DoDot:1
+6 SET CLASSERV=+$ORDER(^PRSE(452,"AK",CLASSTXT,0))
SET CLASSERV=+$GET(^(CLASSERV))
+7 SET CLASSERV(0)=$$SERV(CLASSERV)
+8 QUIT
End DoDot:1
+9 QUIT $SELECT(CLASSERV(0)]"":CLASSERV(0),1:"UNKNOWN")
SERV(Y) QUIT $PIECE($GET(^PRSP(454.1,+$GET(Y),0)),U)
