- PRSEED10 ;HISC/MD/MH-PRSE NON-LOCAL C.E. ATTENDANCE ;06/15/94
- ;;4.0;PAID;**18,23**;Sep 21, 1995
- EN1 ; ENTRY FROM OPTION PRSE-NCEATTEND
- S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
- K ^TMP($J) S (PRSESW,NOUT)=0,PRSESEL="C",(PRSECOD,PRSELCL,PRSEROU)="N",PRSEGF="G" D EN2^PRSEUTL3($G(DUZ)) I PRSESER=""&'(DUZ(0)="@") D MSG3^PRSEMSG G Q1
- OTHER D SCUB G:PRSENAM=""!(PRSEDT="")!("^^"[X) Q1
- ASK K POUT D NAM G:$D(POUT) EN1
- S (NSW,NDUPSW)=0,PRSENAM(0)=PRSENAM D RECHK^PRSEED7 G:NOUT EN1
- I 'NDUPSW S DIC("S")="I $P($G(^(0)),U,7)=PRSESEL" S PRSESEL="C",(PRSECOD,PRSELCL)="N",PRSEGF="G",PRSEROU="N" K POUT D ADD^PRSEED12 G Q1:$G(POUT)
- S X="",PRSESEL="C",(PRSECOD,PRSELCL)="N",PRSEGF="G",PRSEROU="N" G ASK
- Q1 W ! D ^PRSEKILL
- Q
- NAM ;
- K POUT,X,Y
- I $S($G(DUZ(0))["@":1,+$$EN4^PRSEUTL3($G(DUZ)):1,1:0) I $P($G(^PRSE(452.7,1,0)),U,3) D Q:$G(POUT) G NAM1
- . W !
- . S Y=$$ADD^XUSERNEW(9)
- . I $G(Y)'>0 S POUT=1
- ;
- I $S($P($G(^PRSE(452.7,1,0)),U,3)'>0:1,'+$$EN4^PRSEUTL3($G(DUZ)):1,$G(DUZ(0))'["@":1,1:0) D
- . W !!,$C(7),"NEW ENTRIES CANNOT BE ADDED TO THE NEW PERSON FILE FROM THIS OPTION - CONTACT",!,"THE EDUCATION PACKAGE COORDINATOR OR IRM OR SELECT A NAME ALREADY IN FILE.",!
- . S DIC("A")="Select Student Name: "
- . S DIC=200,DIC(0)="AEQM"
- . W ! D ^DIC I X=""!(X["^")!(+Y'>0) K DIC S POUT=1 Q
- . S PRDA(0)=Y
- . ;S DIE=DIC,DA=+Y,DR="9R" D ^DIE K DIC,DIE,DR,DA
- . S Y=PRDA(0)
- ;
- NAM1 Q:$D(POUT)
- I $G(Y)'>0 G NAM
- S (PRDA,VA200DA)=+Y
- S PRSESTUD=$P($G(^VA(200,+Y,0)),U),(SSN,PRSESSN)=$P($G(^VA(200,+Y,1)),U,9) I $G(PRSESSN)="" W !!,"NO SSN OR NEW PERSON (#200) FILE ENTRY FOR THIS EMPLOYEE-CANNOT CONTINUE" G NAM
- S PDA(1)=$S((+$O(^PRSPC("SSN",PRSESSN,0))>0):$O(^PRSPC("SSN",PRSESSN,0)),1:"")
- S PRSESRCE="NON-GOVERNMENT (e.g. Institution, Company or University)"
- ;
- ;get service of user taking non-local course
- D EN2^PRSEUTL3($G(VA200DA)) ;returns PRSESER,PRSESER("TX")
- ;PRSESER=ien of service (454.1)
- ;PRSESER("TX")=name of service
- I PRSESER="" S PRSESER("TX")="NON-EMPLOYEE" ;no CC/Org code
- Q
- SCUB ;
- K DA,DIC,DR,DIE,POUT S (PRSENAM,PRSEDT)="",PRSESW=0
- F K POUT,PRSEY,PRSEED S Y=-1 R !!,"Select NON-LOCAL C.E. CLASS: ",X:DTIME S:'$T X="^^" S:X="" Y="" Q:"^^"[X D Q:Y'=""!(Y<0)
- . S DIC("S")="S DATA=$G(^PRSE(452,Y,0)) I $P($G(^PRSE(452,+Y,6)),U)=""N"",$P(DATA,U,21)=""C"""
- . S DIC("W")="W ?($X+4),$P($G(^(0)),U,13)"
- . S DIC=452,DLAYGO=452,DIC(0)=$E("SZE",1,(X'=" ")+2),D="AK" D IX^DIC K DIC S PRSEDA=+Y 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 $G(X)'="",$G(X)'=" ",$L(X)<2!($L(X)>53) W !!,$C(7),"Answer should be between 2 and 53 characters" S Y="" Q
- . I X=" ",'(+Y>0)!($L(X)<2) S POUT=1 Q
- . S X=$$UP^XLFSTR(X)
- . F W !?3,"ARE YOU ADDING '"_X_"' AS A NEW CLASS" S %=0 D YN^DICN Q:% W !?7,"ANSWER YES OR NO."
- . S Y=$S(%=1:X,%=2:"",1:-1)
- . Q
- Q:Y=""!(Y<0) S PRSENAM=Y K Y
- DATE D EN4^PRSEUTL1($G(PRSENAM)) F S Y=-1 W !!,"Select CLASS DATE: "_$S($G(PRSEY(1))'="":PRSEY(1)_"// ",1:"") R X:DTIME S:'$T X="^^" S:X=""&(+$G(PRSEY)) X=$G(PRSEY) S:X=""&'(+$G(PRSEY)>0) Y="" Q:"^^"[X D Q:Y'=""!(Y<0)
- . I X'?1"?".E S %DT="ET" D ^%DT S:Y'>0 Y="" Q:+Y>DT!(Y'>0) D Q
- . . S X=Y,Y=$S($O(^PRSE(452,"AL"_PRSENAM,Y,0)):Y,1:"") Q:Y>0
- . . F W !?3,"ARE YOU ADDING '" S Y=X D DT^DIQ W "' AS A NEW CLASS DATE" S %=0 D YN^DICN Q:% W !?7,"ANSWER YES OR NO."
- . . S Y=$S(%=1:X,%=2:"",1:-1)
- . . Q
- . W @IOF S (Z,X)=0 F S X=$O(^PRSE(452,"AL"_PRSENAM,X)) Q:X'>0!Z S PRSEDA=0 F S PRSEDA=$O(^PRSE(452,"AL"_PRSENAM,X,PRSEDA)) Q:PRSEDA'>0 D Q:Z
- . . S Y=$P($G(^PRSE(452,PRSEDA,0)),U,3) W !?8 D DT^DIQ
- . . I $Y>(IOSL-3) R !?8,"""^"" TO STOP: ",Z:DTIME S:'$T Z="^^" S Z=(Z="^"!(Z="^^")) W @IOF
- . . Q
- . S %DT="ET" D HELP^%DTC
- . S Y=""
- . Q
- Q:Y=""!(Y<0) D NOW^%DTC I +Y>% W $C(7),!,"You cannot take attendance for a class with a future date!" G DATE
- S PRSEDT=Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEED10 3951 printed Feb 18, 2025@23:52:55 Page 2
- PRSEED10 ;HISC/MD/MH-PRSE NON-LOCAL C.E. ATTENDANCE ;06/15/94
- +1 ;;4.0;PAID;**18,23**;Sep 21, 1995
- EN1 ; ENTRY FROM OPTION PRSE-NCEATTEND
- +1 SET X=$GET(^PRSE(452.7,1,"OFF"))
- IF X=""!(X=1)
- DO MSG6^PRSEMSG
- QUIT
- +2 KILL ^TMP($JOB)
- SET (PRSESW,NOUT)=0
- SET PRSESEL="C"
- SET (PRSECOD,PRSELCL,PRSEROU)="N"
- SET PRSEGF="G"
- DO EN2^PRSEUTL3($GET(DUZ))
- IF PRSESER=""&'(DUZ(0)="@")
- DO MSG3^PRSEMSG
- GOTO Q1
- OTHER DO SCUB
- if PRSENAM=""!(PRSEDT="")!("^^"[X)
- GOTO Q1
- ASK KILL POUT
- DO NAM
- if $DATA(POUT)
- GOTO EN1
- +1 SET (NSW,NDUPSW)=0
- SET PRSENAM(0)=PRSENAM
- DO RECHK^PRSEED7
- if NOUT
- GOTO EN1
- +2 IF 'NDUPSW
- SET DIC("S")="I $P($G(^(0)),U,7)=PRSESEL"
- SET PRSESEL="C"
- SET (PRSECOD,PRSELCL)="N"
- SET PRSEGF="G"
- SET PRSEROU="N"
- KILL POUT
- DO ADD^PRSEED12
- if $GET(POUT)
- GOTO Q1
- +3 SET X=""
- SET PRSESEL="C"
- SET (PRSECOD,PRSELCL)="N"
- SET PRSEGF="G"
- SET PRSEROU="N"
- GOTO ASK
- Q1 WRITE !
- DO ^PRSEKILL
- +1 QUIT
- NAM ;
- +1 KILL POUT,X,Y
- +2 IF $SELECT($GET(DUZ(0))["@":1,+$$EN4^PRSEUTL3($GET(DUZ)):1,1:0)
- IF $PIECE($GET(^PRSE(452.7,1,0)),U,3)
- Begin DoDot:1
- +3 WRITE !
- +4 SET Y=$$ADD^XUSERNEW(9)
- +5 IF $GET(Y)'>0
- SET POUT=1
- End DoDot:1
- if $GET(POUT)
- QUIT
- GOTO NAM1
- +6 ;
- +7 IF $SELECT($PIECE($GET(^PRSE(452.7,1,0)),U,3)'>0:1,'+$$EN4^PRSEUTL3($GET(DUZ)):1,$GET(DUZ(0))'["@":1,1:0)
- Begin DoDot:1
- +8 WRITE !!,$CHAR(7),"NEW ENTRIES CANNOT BE ADDED TO THE NEW PERSON FILE FROM THIS OPTION - CONTACT",!,"THE EDUCATION PACKAGE COORDINATOR OR IRM OR SELECT A NAME ALREADY IN FILE.",!
- +9 SET DIC("A")="Select Student Name: "
- +10 SET DIC=200
- SET DIC(0)="AEQM"
- +11 WRITE !
- DO ^DIC
- IF X=""!(X["^")!(+Y'>0)
- KILL DIC
- SET POUT=1
- QUIT
- +12 SET PRDA(0)=Y
- +13 ;S DIE=DIC,DA=+Y,DR="9R" D ^DIE K DIC,DIE,DR,DA
- +14 SET Y=PRDA(0)
- End DoDot:1
- +15 ;
- NAM1 if $DATA(POUT)
- QUIT
- +1 IF $GET(Y)'>0
- GOTO NAM
- +2 SET (PRDA,VA200DA)=+Y
- +3 SET PRSESTUD=$PIECE($GET(^VA(200,+Y,0)),U)
- SET (SSN,PRSESSN)=$PIECE($GET(^VA(200,+Y,1)),U,9)
- IF $GET(PRSESSN)=""
- WRITE !!,"NO SSN OR NEW PERSON (#200) FILE ENTRY FOR THIS EMPLOYEE-CANNOT CONTINUE"
- GOTO NAM
- +4 SET PDA(1)=$SELECT((+$ORDER(^PRSPC("SSN",PRSESSN,0))>0):$ORDER(^PRSPC("SSN",PRSESSN,0)),1:"")
- +5 SET PRSESRCE="NON-GOVERNMENT (e.g. Institution, Company or University)"
- +6 ;
- +7 ;get service of user taking non-local course
- +8 ;returns PRSESER,PRSESER("TX")
- DO EN2^PRSEUTL3($GET(VA200DA))
- +9 ;PRSESER=ien of service (454.1)
- +10 ;PRSESER("TX")=name of service
- +11 ;no CC/Org code
- IF PRSESER=""
- SET PRSESER("TX")="NON-EMPLOYEE"
- +12 QUIT
- SCUB ;
- +1 KILL DA,DIC,DR,DIE,POUT
- SET (PRSENAM,PRSEDT)=""
- SET PRSESW=0
- +2 FOR
- KILL POUT,PRSEY,PRSEED
- SET Y=-1
- READ !!,"Select NON-LOCAL C.E. CLASS: ",X:DTIME
- if '$TEST
- SET X="^^"
- if X=""
- SET Y=""
- if "^^"[X
- QUIT
- Begin DoDot:1
- +3 SET DIC("S")="S DATA=$G(^PRSE(452,Y,0)) I $P($G(^PRSE(452,+Y,6)),U)=""N"",$P(DATA,U,21)=""C"""
- +4 SET DIC("W")="W ?($X+4),$P($G(^(0)),U,13)"
- +5 SET DIC=452
- SET DLAYGO=452
- SET DIC(0)=$EXTRACT("SZE",1,(X'=" ")+2)
- SET D="AK"
- DO IX^DIC
- KILL DIC
- SET PRSEDA=+Y
- 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
- +6 IF $GET(X)'=""
- IF $GET(X)'=" "
- IF $LENGTH(X)<2!($LENGTH(X)>53)
- WRITE !!,$CHAR(7),"Answer should be between 2 and 53 characters"
- SET Y=""
- QUIT
- +7 IF X=" "
- IF '(+Y>0)!($LENGTH(X)<2)
- SET POUT=1
- QUIT
- +8 SET X=$$UP^XLFSTR(X)
- +9 FOR
- WRITE !?3,"ARE YOU ADDING '"_X_"' AS A NEW CLASS"
- SET %=0
- DO YN^DICN
- if %
- QUIT
- WRITE !?7,"ANSWER YES OR NO."
- +10 SET Y=$SELECT(%=1:X,%=2:"",1:-1)
- +11 QUIT
- End DoDot:1
- if Y'=""!(Y<0)
- QUIT
- +12 if Y=""!(Y<0)
- QUIT
- SET PRSENAM=Y
- KILL Y
- DATE DO EN4^PRSEUTL1($GET(PRSENAM))
- FOR
- SET Y=-1
- WRITE !!,"Select CLASS DATE: "_$SELECT($GET(PRSEY(1))'="":PRSEY(1)_"// ",1:"")
- READ X:DTIME
- if '$TEST
- SET X="^^"
- if X=""&(+$GET(PRSEY))
- SET X=$GET(PRSEY)
- if X=""&'(+$GET(PRSEY)>0)
- SET Y=""
- if "^^"[X
- QUIT
- Begin DoDot:1
- +1 IF X'?1"?".E
- SET %DT="ET"
- DO ^%DT
- if Y'>0
- SET Y=""
- if +Y>DT!(Y'>0)
- QUIT
- Begin DoDot:2
- +2 SET X=Y
- SET Y=$SELECT($ORDER(^PRSE(452,"AL"_PRSENAM,Y,0)):Y,1:"")
- if Y>0
- QUIT
- +3 FOR
- WRITE !?3,"ARE YOU ADDING '"
- SET Y=X
- DO DT^DIQ
- WRITE "' AS A NEW CLASS DATE"
- SET %=0
- DO YN^DICN
- if %
- QUIT
- WRITE !?7,"ANSWER YES OR NO."
- +4 SET Y=$SELECT(%=1:X,%=2:"",1:-1)
- +5 QUIT
- End DoDot:2
- QUIT
- +6 WRITE @IOF
- SET (Z,X)=0
- FOR
- SET X=$ORDER(^PRSE(452,"AL"_PRSENAM,X))
- if X'>0!Z
- QUIT
- SET PRSEDA=0
- FOR
- SET PRSEDA=$ORDER(^PRSE(452,"AL"_PRSENAM,X,PRSEDA))
- if PRSEDA'>0
- QUIT
- Begin DoDot:2
- +7 SET Y=$PIECE($GET(^PRSE(452,PRSEDA,0)),U,3)
- WRITE !?8
- DO DT^DIQ
- +8 IF $Y>(IOSL-3)
- READ !?8,"""^"" TO STOP: ",Z:DTIME
- if '$TEST
- SET Z="^^"
- SET Z=(Z="^"!(Z="^^"))
- WRITE @IOF
- +9 QUIT
- End DoDot:2
- if Z
- QUIT
- +10 SET %DT="ET"
- DO HELP^%DTC
- +11 SET Y=""
- +12 QUIT
- End DoDot:1
- if Y'=""!(Y<0)
- QUIT
- +13 if Y=""!(Y<0)
- QUIT
- DO NOW^%DTC
- IF +Y>%
- WRITE $CHAR(7),!,"You cannot take attendance for a class with a future date!"
- GOTO DATE
- +14 SET PRSEDT=Y
- +15 QUIT