- PRSDADD ;HISC/GWB-PAID ADD NEW EMPLOYEES ;8/20/93 10:44
- ;;4.0;PAID;;Sep 21, 1995
- I TYPE="T" S OLDSSN=$P(^XTMP("PRS",SUB,DATE,TYPE,STA,SSN,TMPIEN),":",10) I OLDSSN'="" D CHGSSN^PRSDERR Q:IEN
- I NAME="" S ERRMSG="SSN "_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)_" not found" D ERR^PRSDSERV Q
- S DIC="^PRSPC(",DIC(0)="L",DIC("DR")="8///"_SSN,DLAYGO=450,X=NAME
- K DD,DO D FILE^DICN
- I Y=-1 S ERRMSG="Error adding "_NAME_" to PAID EMPLOYEE File" D ERR^PRSDSERV Q
- S IEN=+Y,^TMP($J,"PRS",NAME,SSN)=""
- I $D(^VA(200,"SSN",SSN)) S VAIEN=$O(^VA(200,"SSN",SSN,0)),$P(^PRSPC(IEN,200),"^",1)=VAIEN,$P(^VA(200,VAIEN,450),"^",1)=IEN
- I '$D(^VA(200,"SSN",SSN)) S ^TMP($J,"PRSNP",NAME,SSN)=""
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSDADD 691 printed Mar 13, 2025@21:30:05 Page 2
- PRSDADD ;HISC/GWB-PAID ADD NEW EMPLOYEES ;8/20/93 10:44
- +1 ;;4.0;PAID;;Sep 21, 1995
- +2 IF TYPE="T"
- SET OLDSSN=$PIECE(^XTMP("PRS",SUB,DATE,TYPE,STA,SSN,TMPIEN),":",10)
- IF OLDSSN'=""
- DO CHGSSN^PRSDERR
- if IEN
- QUIT
- +3 IF NAME=""
- SET ERRMSG="SSN "_$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)_" not found"
- DO ERR^PRSDSERV
- QUIT
- +4 SET DIC="^PRSPC("
- SET DIC(0)="L"
- SET DIC("DR")="8///"_SSN
- SET DLAYGO=450
- SET X=NAME
- +5 KILL DD,DO
- DO FILE^DICN
- +6 IF Y=-1
- SET ERRMSG="Error adding "_NAME_" to PAID EMPLOYEE File"
- DO ERR^PRSDSERV
- QUIT
- +7 SET IEN=+Y
- SET ^TMP($JOB,"PRS",NAME,SSN)=""
- +8 IF $DATA(^VA(200,"SSN",SSN))
- SET VAIEN=$ORDER(^VA(200,"SSN",SSN,0))
- SET $PIECE(^PRSPC(IEN,200),"^",1)=VAIEN
- SET $PIECE(^VA(200,VAIEN,450),"^",1)=IEN
- +9 IF '$DATA(^VA(200,"SSN",SSN))
- SET ^TMP($JOB,"PRSNP",NAME,SSN)=""
