PRSXP107 ;WCIOFO/MGD,RRG-POST INSTALL CLEAN UP FILE 458 ;02/27/2007
;;4.0;PAID;**107**;Sep 21, 1995;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
;
; This program will delete erroneous Zero nodes in the TIME & ATTENDANCE
; (#458) file starting at Pay Period 03-19.
;
START ; Main Driver
;
D 458
Q
;
;
;
458 ; Correct data in the TIME & ATTENDANCE (#458) file
;
N CNT,DA,DATA,DIK,EMP,EMPX,I,LINE,LINE2,LCNT,MESS,MSG,MSG1
N NAME,TNAME,PPI,STANUM,STATUS,TIME,U,UCIX,PPIEN
S U="^",LCNT=1,$P(LINE,"-",80)="",$P(LINE2,"=",80)="",STATUS="OK"
K ^TMP($J)
S MESS="TIME & ATTENDANCE (#458)",MSG1=" beginning at "
D TIME
D STAUCI
S ^TMP($J,"P107",LCNT)="",LCNT=LCNT+1
S MESS="Deleting erroneous nodes."
S ^TMP($J,"P107",LCNT)=MESS,LCNT=LCNT+1
S ^TMP($J,"P107",LCNT)="",LCNT=LCNT+1
;
; Correct data in the TIME & ATTENDANCE (#458) file
;
S PPI="03-15"
F S PPIEN="",PPI=$O(^PRST(458,"B",PPI)) Q:'PPI!(PPI>"09-20") D
. S PPIEN=$O(^PRST(458,"B",PPI,0)) Q:'PPIEN
. S ^TMP($J,"P107",LCNT)="",LCNT=LCNT+1
. S ^TMP($J,"P107",LCNT)="Pay Period "_PPI,LCNT=LCNT+1
. S ^TMP($J,"P107",LCNT)=LINE2,LCNT=LCNT+1
. S ^TMP($J,"P107",LCNT)="EMP IEN DATA",LCNT=LCNT+1
. S ^TMP($J,"P107",LCNT)=LINE,LCNT=LCNT+1
. S (CNT,EMP)=0
. F S EMP=$O(^PRST(458,PPIEN,"E",EMP)) Q:'EMP D
. . S DATA=$G(^PRST(458,PPIEN,"E",EMP,0))
. . I EMP'=$P(DATA,U,1),($P(DATA,U,2)="") D
. . . S EMPX="",$P(EMPX," ",21)="",$E(EMPX,1,$L(EMP))=EMP
. . . S ^TMP($J,"P107",LCNT)=EMPX_DATA,LCNT=LCNT+1
. . . S CNT=CNT+1
. . . ;
. . . ; Delete the erroneous 0 node
. . . ;
. . . S DA=EMP,DA(1)=PPIEN,DIK="^PRST(458,"_DA(1)_",""E"","
. . . D ^DIK
. S ^TMP($J,"P107",LCNT)="",LCNT=LCNT+1
. S MESS=$S(CNT>0:CNT_" record(s) deleted.",1:"No records to delete")
. S ^TMP($J,"P107",LCNT)=MESS,LCNT=LCNT+1
. S ^TMP($J,"P107",LCNT)="",LCNT=LCNT+1
S MESS="TIME & ATTENDANCE (#458)",MSG1=" ending at "
D TIME
S MSG=MSG_"458 "_STATUS
D XMT
Q
;
;
XMT ; Send status via mail message
;
I $D(^TMP($J,"P107")) D
. N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
. S XMDUZ=.5
. S XMSUB=MSG
. S XMTEXT="^TMP($J,""P107"","
. S XMY(DUZ)=""
. S XMY("G.PAD@"_^XMB("NETNAME"))=""
. D ^XMD
;
K ^TMP($J),Y,%
Q
;
TIME ; Get current Time
;
D NOW^%DTC
S Y=%
D DD^%DT
S TIME=Y
S MESS=MESS_" clean up routine"_MSG1_TIME_"."
S ^TMP($J,"P107",LCNT)=MESS,LCNT=LCNT+1
Q
;
;
STAUCI ;Get Station Number
S STANUM=$$KSP^XUPARAM("INST")_","
S STANUM=$$GET1^DIQ(4,STANUM,99)
S MSG=STANUM_" - "
;
; Check for UCI,VOL
;
X ^%ZOSF("UCI")
S UCIX=$G(Y)
I UCIX="" S UCIX="??????"
S MSG=MSG_UCIX_" - "
Q
;
NAME ; Format name
;
S NAME="",$P(NAME," ",30)=""
S TNAME=$$GET1^DIQ(450,EMP,.01)
I TNAME="" S TNAME=EMP
S $E(NAME,1,$L(TNAME))=TNAME
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSXP107 2882 printed Nov 22, 2024@17:38:49 Page 2
PRSXP107 ;WCIOFO/MGD,RRG-POST INSTALL CLEAN UP FILE 458 ;02/27/2007
+1 ;;4.0;PAID;**107**;Sep 21, 1995;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ;
+7 ; This program will delete erroneous Zero nodes in the TIME & ATTENDANCE
+8 ; (#458) file starting at Pay Period 03-19.
+9 ;
START ; Main Driver
+1 ;
+2 DO 458
+3 QUIT
+4 ;
+5 ;
+6 ;
458 ; Correct data in the TIME & ATTENDANCE (#458) file
+1 ;
+2 NEW CNT,DA,DATA,DIK,EMP,EMPX,I,LINE,LINE2,LCNT,MESS,MSG,MSG1
+3 NEW NAME,TNAME,PPI,STANUM,STATUS,TIME,U,UCIX,PPIEN
+4 SET U="^"
SET LCNT=1
SET $PIECE(LINE,"-",80)=""
SET $PIECE(LINE2,"=",80)=""
SET STATUS="OK"
+5 KILL ^TMP($JOB)
+6 SET MESS="TIME & ATTENDANCE (#458)"
SET MSG1=" beginning at "
+7 DO TIME
+8 DO STAUCI
+9 SET ^TMP($JOB,"P107",LCNT)=""
SET LCNT=LCNT+1
+10 SET MESS="Deleting erroneous nodes."
+11 SET ^TMP($JOB,"P107",LCNT)=MESS
SET LCNT=LCNT+1
+12 SET ^TMP($JOB,"P107",LCNT)=""
SET LCNT=LCNT+1
+13 ;
+14 ; Correct data in the TIME & ATTENDANCE (#458) file
+15 ;
+16 SET PPI="03-15"
+17 FOR
SET PPIEN=""
SET PPI=$ORDER(^PRST(458,"B",PPI))
if 'PPI!(PPI>"09-20")
QUIT
Begin DoDot:1
+18 SET PPIEN=$ORDER(^PRST(458,"B",PPI,0))
if 'PPIEN
QUIT
+19 SET ^TMP($JOB,"P107",LCNT)=""
SET LCNT=LCNT+1
+20 SET ^TMP($JOB,"P107",LCNT)="Pay Period "_PPI
SET LCNT=LCNT+1
+21 SET ^TMP($JOB,"P107",LCNT)=LINE2
SET LCNT=LCNT+1
+22 SET ^TMP($JOB,"P107",LCNT)="EMP IEN DATA"
SET LCNT=LCNT+1
+23 SET ^TMP($JOB,"P107",LCNT)=LINE
SET LCNT=LCNT+1
+24 SET (CNT,EMP)=0
+25 FOR
SET EMP=$ORDER(^PRST(458,PPIEN,"E",EMP))
if 'EMP
QUIT
Begin DoDot:2
+26 SET DATA=$GET(^PRST(458,PPIEN,"E",EMP,0))
+27 IF EMP'=$PIECE(DATA,U,1)
IF ($PIECE(DATA,U,2)="")
Begin DoDot:3
+28 SET EMPX=""
SET $PIECE(EMPX," ",21)=""
SET $EXTRACT(EMPX,1,$LENGTH(EMP))=EMP
+29 SET ^TMP($JOB,"P107",LCNT)=EMPX_DATA
SET LCNT=LCNT+1
+30 SET CNT=CNT+1
+31 ;
+32 ; Delete the erroneous 0 node
+33 ;
+34 SET DA=EMP
SET DA(1)=PPIEN
SET DIK="^PRST(458,"_DA(1)_",""E"","
+35 DO ^DIK
End DoDot:3
End DoDot:2
+36 SET ^TMP($JOB,"P107",LCNT)=""
SET LCNT=LCNT+1
+37 SET MESS=$SELECT(CNT>0:CNT_" record(s) deleted.",1:"No records to delete")
+38 SET ^TMP($JOB,"P107",LCNT)=MESS
SET LCNT=LCNT+1
+39 SET ^TMP($JOB,"P107",LCNT)=""
SET LCNT=LCNT+1
End DoDot:1
+40 SET MESS="TIME & ATTENDANCE (#458)"
SET MSG1=" ending at "
+41 DO TIME
+42 SET MSG=MSG_"458 "_STATUS
+43 DO XMT
+44 QUIT
+45 ;
+46 ;
XMT ; Send status via mail message
+1 ;
+2 IF $DATA(^TMP($JOB,"P107"))
Begin DoDot:1
+3 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
+4 SET XMDUZ=.5
+5 SET XMSUB=MSG
+6 SET XMTEXT="^TMP($J,""P107"","
+7 SET XMY(DUZ)=""
+8 SET XMY("G.PAD@"_^XMB("NETNAME"))=""
+9 DO ^XMD
End DoDot:1
+10 ;
+11 KILL ^TMP($JOB),Y,%
+12 QUIT
+13 ;
TIME ; Get current Time
+1 ;
+2 DO NOW^%DTC
+3 SET Y=%
+4 DO DD^%DT
+5 SET TIME=Y
+6 SET MESS=MESS_" clean up routine"_MSG1_TIME_"."
+7 SET ^TMP($JOB,"P107",LCNT)=MESS
SET LCNT=LCNT+1
+8 QUIT
+9 ;
+10 ;
STAUCI ;Get Station Number
+1 SET STANUM=$$KSP^XUPARAM("INST")_","
+2 SET STANUM=$$GET1^DIQ(4,STANUM,99)
+3 SET MSG=STANUM_" - "
+4 ;
+5 ; Check for UCI,VOL
+6 ;
+7 XECUTE ^%ZOSF("UCI")
+8 SET UCIX=$GET(Y)
+9 IF UCIX=""
SET UCIX="??????"
+10 SET MSG=MSG_UCIX_" - "
+11 QUIT
+12 ;
NAME ; Format name
+1 ;
+2 SET NAME=""
SET $PIECE(NAME," ",30)=""
+3 SET TNAME=$$GET1^DIQ(450,EMP,.01)
+4 IF TNAME=""
SET TNAME=EMP
+5 SET $EXTRACT(NAME,1,$LENGTH(TNAME))=TNAME
+6 QUIT
+7 ;
