Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSXP105

PRSXP105.m

Go to the documentation of this file. 
  1. PRSXP105 ;WCIOFO/RRG-CORRECT VCS ALLOTMENT ;11/18/2005
  1.  ;;4.0;PAID;**105**;Sep 21, 1995
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. READ ; This module will run as a post install for *105
  1.  ; It will update the read access value and the 
  1.  ; 'Date Last Updated' for 4 fields in #450
  1.  ; 
  1.  F I=758,759,760,761 S ^DD(450,I,8)="FP",^DD(450,I,"DT")=DT
  1.  Q
  1.  ;
  1.  ;
  1.  ; The remainder of this program will correct the formatting
  1.  ;  for the following fields:
  1.  ;
  1.  ; PAID EMPLOYEE (#450)
  1.  ;   #586.1 - VCS ALLOTMENT AMT
  1.  ;
  1.  ; PAID PAYRUN DATA (#459)
  1.  ;   #171 - VCS ALLOTMENT AMT
  1.  ;
  1. DEVICE ;Ask device or queue
  1.  ;
  1.  ;
  1.  W ! K IOP,%ZIS
  1.  S %ZIS("A")="Select Device: ",%ZIS="MQ"
  1.  D ^%ZIS K %ZIS,IOP
  1.  Q:POP
  1.  ;
  1.  I $D(IO("Q")) D  Q
  1.  . S PRSAPGM="START^PRSXP105",XQY0="CORRECT VCS ALLOTTMENT FIELDS",PRSALST=""
  1.  . D QUE^PRSAUTL
  1.  . K PRSAPGM,XQY0,PRSALST,POP
  1.  ;
  1.  ;
  1. START ; Main Driver
  1.  ;
  1.  D 450
  1.  D 459
  1.  I $D(^TMP($J,"LOCKED","P105")) D WARN
  1.  Q
  1.  ;
  1. 450 ; Correct data in the PAID EMPLOYEE (#450) file
  1.  ;
  1.  N CNT,DA,DATA,DIE,DR,EMP,LCNT,LINE,LINE2,MESS,MSG,MSG1,LKCNT
  1.  N NAME,PVAL,STANUM,STATUS,TIME,TNAME,U,UCIX,FILE
  1.  S U="^",LCNT=1,$P(LINE,"-",80)="",$P(LINE2,"=",80)="",STATUS="OK"
  1.  K ^TMP($J)
  1.  S MESS="PAID EMPLOYEE (#450)",MSG1=" beginning at "
  1.  D TIME
  1.  D STAUCI
  1.  S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  S MESS="Correcting the VCS ALLOTMENT AMT (#586.1) field."
  1.  S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
  1.  S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  S ^TMP($J,"P105",LCNT)=LINE2,LCNT=LCNT+1
  1.  S MESS="                            CURRENT    CORRECTED"
  1.  S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
  1.  S MESS="PAID EMPLOYEE (#450)          VALUE    VALUE"
  1.  S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
  1.  S ^TMP($J,"P105",LCNT)=LINE,LCNT=LCNT+1
  1.  ;
  1.  ;
  1.  S (EMP,CNT)=0,LKCNT=1,FILE=450
  1.  F  S EMP=$O(^PRSPC(EMP)) Q:'EMP  D
  1.  . S DATA=$$GET1^DIQ(450,EMP,586.1)
  1.  . Q:DATA=""  ; Quit if they don't have any VCS Allotment
  1.  . ; Quit if the value has already been formatted by another download
  1.  . Q:DATA["."
  1.  . D NAME
  1.  . L +^PRSPC(EMP):0
  1.  . I '$T D LOCKED  Q
  1.  . S PVAL=DATA ; Previous value
  1.  . D DD^PRSDUTIL
  1.  . S DR="586.1///^S X=DATA",DA=EMP,DIE=450
  1.  . D ^DIE
  1.  . L -^PRSPC(EMP)
  1.  . S CNT=CNT+1
  1.  . S MESS=NAME,$E(MESS,31,35)=PVAL,$E(MESS,40,46)=DATA
  1.  . S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
  1.  S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  S ^TMP($J,"P105",LCNT)=LINE,LCNT=LCNT+1
  1.  S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  S MESS=$S(CNT>0:CNT_" employee(s) corrected.",1:"No records to correct")
  1.  S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
  1.  I STATUS="Check" D
  1.  . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  . S ^TMP($J,"P105",LCNT)=LKCNT_" Employee record(s) were locked."
  1.  . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  S MESS="PAID EMPLOYEE (#450)",MSG1=" ending at "
  1.  D TIME
  1.  S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  S STATUS="OK",MSG=MSG_"450 "_STATUS
  1.  D XMT
  1.  Q
  1.  ;
  1.  ;
  1. 459 ; Correct data in the PAID PAYRUN DATA (#459) file
  1.  ;
  1.  N CNT,DATA,EMP,I,IENS,LCNT,LINE,MESS,MSG
  1.  N NAME,PPE,PPI,PPIEN,PRSFDA,PVAL,STANUM,STATUS,TIME,TNAME,U,UCIX,FILE
  1.  S U="^",LCNT=1,$P(LINE,"-",80)="",$P(LINE2,"=",80)="",STATUS="OK",FILE=459
  1.  K ^TMP($J,"P105")
  1.  S MESS="PAID PAYRUN DATA (#459)",MSG1=" beginning at "
  1.  D TIME
  1.  D STAUCI
  1.  S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  S MESS="Correcting the VCS ALLOTMENT AMT (#171) field of the"
  1.  S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
  1.  S MESS="EMPLOYEE (#459.01) multiple."
  1.  S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
  1.  S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  S PPI="03-10"
  1.  F  S PPIEN="",PPI=$O(^PRST(459,"B",PPI)) Q:'PPI!(PPI>"07-20")  D
  1.  . S PPIEN=$O(^PRST(459,"B",PPI,0)) Q:'PPIEN
  1.  . S PPE=$P(^PRST(459,PPIEN,0),"^")
  1.  . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  . S ^TMP($J,"P105",LCNT)="Pay Period "_PPE,LCNT=LCNT+1
  1.  . S ^TMP($J,"P105",LCNT)=LINE2,LCNT=LCNT+1
  1.  . S MESS="                             CURRENT   CORRECTED"
  1.  . S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
  1.  . S MESS="PAID PAYRUN DATA (#459)        VALUE   VALUE"
  1.  . S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
  1.  . S ^TMP($J,"P105",LCNT)=LINE,LCNT=LCNT+1
  1.  . S (CNT,EMP)=0
  1.  . F  S EMP=$O(^PRST(459,PPIEN,"P",EMP)) Q:'EMP  D
  1.  . . S IENS=EMP_","_PPIEN_","
  1.  . . S DATA=$$GET1^DIQ(459.01,IENS,171)
  1.  . . Q:DATA=""  ; Quit if they don't have any VCS Allotment
  1.  . . ; Quit if the value has already been formatted by another download
  1.  . . Q:DATA["."
  1.  . . D NAME
  1.  . . L +^PRST(459,PPIEN,"P",EMP):0
  1.  . . I '$T D LOCKED Q
  1.  . . S PVAL=DATA
  1.  . . D DD^PRSDUTIL
  1.  . . S IENS=EMP_","_PPIEN_",",PRSFDA(459.01,IENS,171)=DATA
  1.  . . D FILE^DIE("","PRSFDA") ; Correct data
  1.  . . S CNT=CNT+1
  1.  . . L -^PRST(459,PPIEN,"P",EMP)
  1.  . . S $E(NAME,1,$L(TNAME))=TNAME,$E(NAME,31,35)=PVAL,$E(NAME,40,46)=DATA
  1.  . . S ^TMP($J,"P105",LCNT)=NAME,LCNT=LCNT+1
  1.  . S MESS=$S(CNT>0:CNT_" employee(s) corrected.",1:"No records to correct")
  1.  . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  . S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
  1.  . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  . I STATUS="Check" D
  1.  . . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  . . S ^TMP($J,"P105",LCNT)=LKCNT_" Employee record(s) were locked."
  1.  . . S ^TMP($J,"P105",LCNT)="",LCNT=LCNT+1
  1.  S MESS="PAID PAYRUN DATA (#459)",MSG1=" ending at "
  1.  D TIME
  1.  S STATUS="OK",MSG=MSG_"459 "_STATUS
  1.  D XMT
  1.  Q
  1.  ;
  1. XMT ; Send status via mail message
  1.  ;
  1.  I $D(^TMP($J,"P105")) D
  1.  . N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
  1.  . S XMDUZ=.5
  1.  . S XMSUB=MSG
  1.  . S XMTEXT="^TMP($J,""P105"","
  1.  . S XMY(DUZ)=""
  1.  . S XMY("G.PAD@"_^XMB("NETNAME"))=""
  1.  . D ^XMD
  1.  ;
  1.  K ^TMP($J,"P105"),Y,%
  1.  Q
  1.  ;
  1. TIME ; Get current Time
  1.  ;
  1.  D NOW^%DTC
  1.  S Y=%
  1.  D DD^%DT
  1.  S TIME=Y
  1.  S MESS=MESS_" clean up routine"_MSG1_TIME_"."
  1.  S ^TMP($J,"P105",LCNT)=MESS,LCNT=LCNT+1
  1.  Q
  1.  ;
  1.  ; Get Station Number
  1.  ;
  1. STAUCI S STANUM=$$KSP^XUPARAM("INST")_","
  1.  S STANUM=$$GET1^DIQ(4,STANUM,99)
  1.  S MSG=STANUM_" - "
  1.  ;
  1.  ; Check for UCI,VOL
  1.  ;
  1.  X ^%ZOSF("UCI")
  1.  S UCIX=$G(Y)
  1.  I UCIX="" S UCIX="??????"
  1.  S MSG=MSG_UCIX_" - "
  1.  Q
  1.  ;
  1. NAME ; Format name
  1.  ;
  1.  S NAME="",$P(NAME," ",30)=""
  1.  S TNAME=$$GET1^DIQ(450,EMP,.01)
  1.  I TNAME="" S TNAME=EMP
  1.  S $E(NAME,1,$L(TNAME))=TNAME
  1.  Q
  1.  ;
  1. LOCKED ; Message for locked records
  1.  ;
  1.  S MESS=NAME_" record was locked in file # "_FILE
  1.  S ^TMP($J,"LOCKED","P105",LKCNT)=MESS,LKCNT=LKCNT+1
  1.  S STATUS="Check"
  1.  Q
  1.  ;
  1. WARN ; Warning message if records were locked
  1.  ;
  1.  S ^TMP($J,"LOCKED","P105",LKCNT)="",LKCNT=LKCNT+1
  1.  S ^TMP($J,"LOCKED","P105",LKCNT)="These records were locked.",LKCNT=LKCNT+1
  1.  S ^TMP($J,"LOCKED","P105",LKCNT)="Contact NVS @ 888-596-4357",LKCNT=LKCNT+1
  1.  ;
  1.  I $D(^TMP($J,"LOCKED","P105")) D
  1.  . N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
  1.  . S XMDUZ=.5
  1.  . S XMSUB="Locked records - PRS*4*105"
  1.  . S XMTEXT="^TMP($J,""LOCKED"",""P105"","
  1.  . S XMY(DUZ)=""
  1.  . S XMY("G.PAD@"_^XMB("NETNAME"))=""
  1.  . D ^XMD
  1.  ;
  1.  K ^TMP($J,"LOCKED","P105"),Y,%
  1.  Q
  1.  ;