- 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 Mar 13, 2025@21:31:22 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)
