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

PRSXP82.m

Go to the documentation of this file.
  1. PRSXP82 ;WCIOFO/MGD-ADD CENTRAL,PAID TO #200 ;09/16/2003
  1. ;;4.0;PAID;**82**;Sep 21, 1995
  1. ;
  1. Q
  1. ;
  1. ; This program will add the new entry CENTRAL,PAID to the NEW PERSON
  1. ; (#200) file. This entry will be used by the VistA PAID/ETA
  1. ; software to track changes in the employee's Labor Distribution(s)
  1. ; through the processing of the various downloads received from
  1. ; Central Paid in Austin, Texas. It will also add
  1. ;
  1. ; For more details see the patch description on FORUM.
  1. ;
  1. START ; Main Driver
  1. ;
  1. N DIC,DIERR,DLAYGO,I,IENS,LCNT,MSG,PRSFDA,STA1,STA2,STA3,STANUM
  1. N STATUS,TIME,TOI,U,UCIX,X,Y
  1. S U="^",LCNT=1,(STA1,STA2,STA3)=""
  1. K ^TMP($J)
  1. D NOW^%DTC
  1. S Y=%
  1. D DD^%DT
  1. S TIME=Y
  1. W !!,"Post install routine PRSXP82 beginning at ",TIME_".",!
  1. ;
  1. ; Get Station Number
  1. ;
  1. S STANUM=$$KSP^XUPARAM("INST")_","
  1. S STANUM=$$GET1^DIQ(4,STANUM,99)
  1. S MSG="Station: "_STANUM_" - "
  1. ;
  1. ; Check for UCI,VOL
  1. ;
  1. X ^%ZOSF("UCI")
  1. S UCIX=$G(Y)
  1. I UCIX=""!(UCIX'?3U1","3U) S UCIX="???,???"
  1. S MSG=MSG_UCIX_" - "
  1. ;
  1. S X=$O(^VA(200,"B","CENTRAL,PAID",0))
  1. I X D ERR1
  1. ;
  1. I 'X D
  1. . S X="CENTRAL,PAID",DIC(0)="L",DLAYGO=200,DIC="^VA(200,"
  1. . D FILE^DICN
  1. . I Y=-1 D ERR2
  1. . I $P(Y,U,3) D
  1. . . S ^TMP($J,"MGD",LCNT)=MSG_" CENTRAL,PAID added."
  1. . . S LCNT=LCNT+1
  1. . . W !,MSG_" CENTRAL,PAID added."
  1. ;
  1. TOI ; Create entries for the Types Of Interfaces
  1. K PRSFDA
  1. W !
  1. S LCNT=LCNT+1
  1. S ^TMP($J,"MGD",LCNT)=""
  1. S LCNT=LCNT+1
  1. F I=1:1:4 D
  1. . S TOI=$S(I=1:"INITIAL",I=2:"EDIT & UPDATE",I=3:"TRANSFER",4:"PAYRUN",1:"INITIAL")
  1. . S IENS="?+"_I_",1,"
  1. . S PRSFDA(454.02,IENS,.01)=I
  1. . S PRSFDA(454.02,IENS,1)=TOI
  1. . D UPDATE^DIE("","PRSFDA")
  1. . I $D(DIERR)>0 D
  1. . . S LCNT=LCNT+1
  1. . . S ^TMP($J,"MGD",LCNT)=MSG_" unable to add "_TOI_" entry."
  1. . . W !,MSG_" unable to add "_TOI_" entry.",!
  1. . . S STA3=" ERROR #3"
  1. . I $D(DIERR)<1 D
  1. . . S LCNT=LCNT+1
  1. . . S ^TMP($J,"MGD",LCNT)=MSG_" entry "_TOI_" added."
  1. . . W !,MSG_" entry "_TOI_" added."
  1. ;
  1. XMT ; Send status via mail message
  1. ;
  1. I $D(^TMP($J,"MGD")) D
  1. . S STATUS=STA1_STA2_STA3
  1. . I STATUS'["ERROR" S STATUS="NO ERRORS"
  1. . N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY
  1. . S XMDUZ=.5
  1. . S XMSUB=MSG_" - "_STATUS_"."
  1. . S XMTEXT="^TMP($J,""MGD"","
  1. . S XMY("DILL.MATT@DOMAIN.EXT")="",XMY(DUZ)=""
  1. . S XMY("MCCLARAN.PAM@DOMAIN.EXT")=""
  1. . D ^XMD
  1. ;
  1. K ^TMP($J),Y,%
  1. W !!,"Post install routine PRSXP82 completed."
  1. W !,"Status: ",STATUS_"."
  1. Q
  1. ;
  1. ERR1 ; Error message if CENTRAL,PAID already exists
  1. S ^TMP($J,"MGD",LCNT)=MSG_" CENTRAL,PAID entry already exists."
  1. S LCNT=LCNT+1
  1. W !,MSG_" CENTRAL,PAID entry already exists."
  1. S STA1="ERROR #1 "
  1. Q
  1. ;
  1. ERR2 ; Error message if unable to add CENTRAL,PAID entry
  1. S ^TMP($J,"MGD",LCNT)=MSG_" unable to add CENTRAL,PAID entry."
  1. S LCNT=LCNT+1
  1. W !,MSG_" unable to add CENTRAL,PAID entry."
  1. S STA2=" ERROR #2 "
  1. Q
  1. ;