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 Apr 09, 2024@21:30:43 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
