- PRSAPEM ; HISC/REL-Post Miscellaneous ;3/10/93 12:50
- ;;4.0;PAID;;Sep 21, 1995
- K DIC S DIC="^PRST(458,",DIC(0)="AEQM",DIC("A")="Select PAY PERIOD: " W ! D ^DIC K DIC G:Y<1 EX
- S PPI=+Y,PPE=$P($G(^PRST(458,PPI,0)),"^",1)
- NME K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $D(^PRST(458,PPI,""E"",+Y))",DIC(0)="AEQM",DIC="^PRSPC(" W ! D ^DIC S DFN=+Y K DIC
- I DFN<1 G EX
- I $P($G(^PRST(458,PPI,"E",DFN,0)),"^",2)="X" W *7,!!,"This Employee has already been transmitted by Payroll." G NME
- P3 K DDSFILE,DA,DR S DDSFILE=458,DDSFILE(1)=458.01,DA(1)=PPI,DA=DFN
- S DR="[PRSA PM POST]" D ^DDS K DS
- I $P($G(^PRST(458,PPI,"E",DFN,0)),"^",2)="P" K ^(5) D ONE^PRS8 S ^PRST(458,PPI,"E",DFN,5)=VAL
- EX G KILL^XUSCLEAN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAPEM 717 printed Apr 23, 2025@18:38:25 Page 2
- PRSAPEM ; HISC/REL-Post Miscellaneous ;3/10/93 12:50
- +1 ;;4.0;PAID;;Sep 21, 1995
- +2 KILL DIC
- SET DIC="^PRST(458,"
- SET DIC(0)="AEQM"
- SET DIC("A")="Select PAY PERIOD: "
- WRITE !
- DO ^DIC
- KILL DIC
- if Y<1
- GOTO EX
- +3 SET PPI=+Y
- SET PPE=$PIECE($GET(^PRST(458,PPI,0)),"^",1)
- NME KILL DIC
- SET DIC("A")="Select EMPLOYEE: "
- SET DIC("S")="I $D(^PRST(458,PPI,""E"",+Y))"
- SET DIC(0)="AEQM"
- SET DIC="^PRSPC("
- WRITE !
- DO ^DIC
- SET DFN=+Y
- KILL DIC
- +1 IF DFN<1
- GOTO EX
- +2 IF $PIECE($GET(^PRST(458,PPI,"E",DFN,0)),"^",2)="X"
- WRITE *7,!!,"This Employee has already been transmitted by Payroll."
- GOTO NME
- P3 KILL DDSFILE,DA,DR
- SET DDSFILE=458
- SET DDSFILE(1)=458.01
- SET DA(1)=PPI
- SET DA=DFN
- +1 SET DR="[PRSA PM POST]"
- DO ^DDS
- KILL DS
- +2 IF $PIECE($GET(^PRST(458,PPI,"E",DFN,0)),"^",2)="P"
- KILL ^(5)
- DO ONE^PRS8
- SET ^PRST(458,PPI,"E",DFN,5)=VAL
- EX GOTO KILL^XUSCLEAN
