ECTPEMP.m

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 ---ECTPEMP   1597     printed  Apr 09, 2024@21:04:36                                                                                                                                                                                                     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       ;