ECTPEMP ;B'ham ISC/PTD-Employee Inquiry ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;**11,16**;
;ROUTINE PULLS DATA FROM FILE 450 - CURRENT EMPLOYEE AND FROM FILE 200 - NEW PERSON
I '$D(^PRSPC) W *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'Current Employee' File - #450 is not loaded on your system.",!! S XQUIT="" Q
I '$O(^PRSPC(0)) W *7,!!,"'Current Employee' File - #450 has not been populated on your system.",!! S XQUIT="" Q
DIC W !! S DIC="^PRSPC(",DIC(0)="QEANMZ",DIC("A")="Select EMPLOYEE name: " D ^DIC K DIC G:Y<0 EXIT S EMPDA=+Y
S NM=Y(0,0),SCD=$P(Y(0),"^",31),EMPSN=$P(Y(0),"^",9)
K %ZIS S IOP="HOME" D ^%ZIS K %ZIS,IOP W @IOF,!!?33,"EMPLOYEE DATA:",!,"NAME: ",NM,! I EMPSN="" W *7,"Employee SSN is missing in 'Current Employee' - File #450." K Y,NM,EMPSN G DIC
I SCD'="" W !?2,"Service Computation Date: " S Y=SCD D DD^%DT W Y
I $D(^PRSPC(EMPDA,0)) S SAL=$P(^PRSPC(EMPDA,0),"^",29) I SAL'="" W !?2,"Salary: " S X=SAL,X2="2$" D COMMA^%DTC W X
I $D(^PRSPC(EMPDA,0)) S TITL=$P(^PRSPC(EMPDA,0),"^",17) I (TITL'=""),($O(^PRSP(454,1,"OCC","B",TITL,0))) S OCCDA=$O(^PRSP(454,1,"OCC","B",TITL,0)) W !?2,"Title: ",$P(^PRSP(454,1,"OCC",OCCDA,0),"^",2)
I '$D(^VA(200,"SSN",EMPSN)) W !!?25,"NO ADDITIONAL DATA AVIALABLE.",!,"Employee SSN is not listed in file #200." K Y,NM,EMPSN G DIC
200 S PRSNDA=$O(^VA(200,"SSN",EMPSN,0)),DOB=$P(^VA(200,PRSNDA,1),"^",3)
S DIC="^VA(200,",DA=PRSNDA,DR="5;.13;.11" D EN^DIQ K DIC,DA,DR S Y=DOB W:DOB'="" !?2,"BIRTH DATE: " D:DOB'="" DT^DIQ G DIC
EXIT K %,A,C,D0,DOB,EMPDA,EMPSN,NM,OCCDA,POP,PRSNDA,S,SAL,SCD,SN,TITL,X,X2,Y
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTPEMP 1597 printed Oct 16, 2024@18:03:25 Page 2
ECTPEMP ;B'ham ISC/PTD-Employee Inquiry ;01/29/91 08:00
V ;;1.05;INTERIM MANAGEMENT SUPPORT;**11,16**;
+1 ;ROUTINE PULLS DATA FROM FILE 450 - CURRENT EMPLOYEE AND FROM FILE 200 - NEW PERSON
+2 IF '$DATA(^PRSPC)
WRITE *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'Current Employee' File - #450 is not loaded on your system.",!!
SET XQUIT=""
QUIT
+3 IF '$ORDER(^PRSPC(0))
WRITE *7,!!,"'Current Employee' File - #450 has not been populated on your system.",!!
SET XQUIT=""
QUIT
DIC WRITE !!
SET DIC="^PRSPC("
SET DIC(0)="QEANMZ"
SET DIC("A")="Select EMPLOYEE name: "
DO ^DIC
KILL DIC
if Y<0
GOTO EXIT
SET EMPDA=+Y
+1 SET NM=Y(0,0)
SET SCD=$PIECE(Y(0),"^",31)
SET EMPSN=$PIECE(Y(0),"^",9)
+2 KILL %ZIS
SET IOP="HOME"
DO ^%ZIS
KILL %ZIS,IOP
WRITE @IOF,!!?33,"EMPLOYEE DATA:",!,"NAME: ",NM,!
IF EMPSN=""
WRITE *7,"Employee SSN is missing in 'Current Employee' - File #450."
KILL Y,NM,EMPSN
GOTO DIC
+3 IF SCD'=""
WRITE !?2,"Service Computation Date: "
SET Y=SCD
DO DD^%DT
WRITE Y
+4 IF $DATA(^PRSPC(EMPDA,0))
SET SAL=$PIECE(^PRSPC(EMPDA,0),"^",29)
IF SAL'=""
WRITE !?2,"Salary: "
SET X=SAL
SET X2="2$"
DO COMMA^%DTC
WRITE X
+5 IF $DATA(^PRSPC(EMPDA,0))
SET TITL=$PIECE(^PRSPC(EMPDA,0),"^",17)
IF (TITL'="")
IF ($ORDER(^PRSP(454,1,"OCC","B",TITL,0)))
SET OCCDA=$ORDER(^PRSP(454,1,"OCC","B",TITL,0))
WRITE !?2,"Title: ",$PIECE(^PRSP(454,1,"OCC",OCCDA,0),"^",2)
+6 IF '$DATA(^VA(200,"SSN",EMPSN))
WRITE !!?25,"NO ADDITIONAL DATA AVIALABLE.",!,"Employee SSN is not listed in file #200."
KILL Y,NM,EMPSN
GOTO DIC
200 SET PRSNDA=$ORDER(^VA(200,"SSN",EMPSN,0))
SET DOB=$PIECE(^VA(200,PRSNDA,1),"^",3)
+1 SET DIC="^VA(200,"
SET DA=PRSNDA
SET DR="5;.13;.11"
DO EN^DIQ
KILL DIC,DA,DR
SET Y=DOB
if DOB'=""
WRITE !?2,"BIRTH DATE: "
if DOB'=""
DO DT^DIQ
GOTO DIC
EXIT KILL %,A,C,D0,DOB,EMPDA,EMPSN,NM,OCCDA,POP,PRSNDA,S,SAL,SCD,SN,TITL,X,X2,Y
+1 QUIT
+2 ;
