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

PRCAP269.m

Go to the documentation of this file. 
  1. PRCAP269 ;ALB/PJH - PRCA*4.5*269 POST INSTALL ; 3/9/11 12:50pm
  1.  ;;4.5;Accounts Receivable;**269**;Mar 20, 1995;Build 113
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  Q
  1.  ;
  1. POST ;Called from PRCA*4.5*269 patch install
  1.  ;
  1.  ;Move ERA file #344.4 and EFT file #344.31 fields to new locations
  1.  ;
  1.  N M,OK,PROG,X,X1,X2
  1.  S PROG="PRCAP269"
  1.  ;Clear workfile
  1.  K ^TMP(PROG,$J)
  1.  ;
  1.  ;Lock ^XTMP
  1.  L +^XTMP(PROG):5 E  D BMES^XPDUTL("Conversion ABORTED") Q
  1.  ;XTMP purge Date is today+90
  1.  S X1=DT,X2=90 D C^%DTC
  1.  ;Set up ^XTMP header
  1.  S ^XTMP(PROG,0)=X_"^"_DT_"^PRCA*4.5*269 Post Install"
  1.  ;
  1.  D BMES^XPDUTL("Deleting Obsolete Cross References")
  1.  D DELIX^DDMOD(344.31,.02,1) ;PAYER NAME - "C"
  1.  D DELIX^DDMOD(344.31,.04,1) ;TRACE # - "D"
  1.  D DELIX^DDMOD(344.4,.02,1) ;TRACE # - "D"
  1.  D DELIX^DDMOD(344.42,.01,1) ;REFERENCE NUMBER - "B"
  1.  ;
  1.  D BMES^XPDUTL("Converting EDI THIRD PARTY EFT DETAIL FILE")
  1.  D MOVEEFT
  1.  ;
  1.  D BMES^XPDUTL("Converting ELECTRONIC REMITTANCE ADVICE file")
  1.  D MOVEERA,MOVEERA1,MOVEERA2
  1.  ;
  1.  ;Send mail message to patch installer
  1.  D MAIL
  1.  ;
  1.  ;Send mail message to CBO release coordinators
  1.  D MAILCBO
  1.  ;
  1.  ;Clear workfile
  1.  K ^TMP(PROG,$J)
  1.  ;
  1.  D BMES^XPDUTL("Conversion COMPLETED")
  1.  ;Release ^XTMP
  1.  L -^XTMP(PROG)
  1.  Q
  1.  ;
  1. MAIL ;Installer mail message
  1.  N XMDUZ,XMTEXT,XMSUB,XMY,XMINSTR
  1.  S XMDUZ=DUZ
  1.  S XMTEXT="^TMP(""PRCAP269"","_$J_")"
  1.  S XMSUB="PRCA*4.5*269 Post Install - Completed"
  1.  S XMY(DUZ)=""
  1.  S XMINSTR("FROM")="VistA routine PRCAP269"
  1.  D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
  1.  Q
  1.  ;
  1. MAILCBO ;CBO notification mail message
  1.  N %,INSTNAME,M,MSG,SITE,STATION,X,XMDUZ,XMTEXT,XMSUB,XMY,XMINSTR
  1.  S M=0
  1.  D NOW^%DTC
  1.  ;IA - 10112 supported reference
  1.  S SITE=$$SITE^VASITE,STATION=$P(SITE,U,3),INSTNAME=$P(SITE,U,2)
  1.  S M=M+1,MSG(M)="Institution Name: "_INSTNAME
  1.  S M=M+1,MSG(M)="Station Number  : "_STATION
  1.  S M=M+1,MSG(M)=""
  1.  S M=M+1,MSG(M)="Completed Install "_$$FMTE^XLFDT(%)
  1.  S XMDUZ=DUZ
  1.  S XMTEXT="MSG"
  1.  S XMSUB="ePayments - Station "_STATION
  1.  S XMY(DUZ)=""
  1.  S:$$PROD^XUPROD(1) XMY("VHACBOEPAY5010@DOMAIN.EXT")=""
  1.  S XMINSTR("FROM")="VistA routine PRCAP269"
  1.  D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
  1.  ;
  1.  I $D(^TMP("XMERR",$J)) D
  1.  .D MES^XPDUTL("MailMan reported a problem trying to send the installation notification message.")
  1.  .D MES^XPDUTL("  ")
  1.  .N GLO,GLB
  1.  .S GLB="^TMP(""XMERR"","_$J,GLO=GLB_")"
  1.  .F  S GLO=$Q(@GLO) Q:GLO'[GLB  D MES^XPDUTL("   "_GLO_" = "_$G(@GLO))
  1.  .D MES^XPDUTL("  ")
  1.  Q
  1.  ;
  1. MOVEEFT ;Move existing EFT (File #344.31) field to new global node
  1.  ;
  1.  ;Moves field ACH TRACE # (.15)
  1.  ;from ^RCY(344.31,D0,0) piece 15
  1.  ;to ^RCY(344.31,D0,1) piece 1
  1.  ;
  1.  ;Moves field MANUAL TR DOCUMENT (.16)
  1.  ;from ^RCY(344.31,D0,0) piece 16
  1.  ;to ^RCY(344.31,D0,1) piece 2
  1.  ;
  1.  N %,C,I,N,VALUE,X
  1.  S C=0,M=0
  1.  ;Update mail message
  1.  D NOW^%DTC
  1.  S M=M+1,^TMP(PROG,$J,M)="Started EFT file at "_$$FMTE^XLFDT(%)
  1.  ;Scan file moving non-null fields only into ^XTMP and new location
  1.  ;and clear field in original location
  1.  S N=0 F I=1:1 S N=$O(^RCY(344.31,N)) Q:'N  S VALUE=$P($G(^RCY(344.31,N,0)),U,15,16) I $P(VALUE,U)'="",$P(VALUE,U,2)'="" S C=C+1,^XTMP(PROG,"EFT",C)=VALUE_U_N,^RCY(344.31,N,1)=VALUE,$P(^RCY(344.31,N,0),U,15)="",$P(^RCY(344.31,N,0),U,16)=""
  1.  ;Completion time
  1.  D NOW^%DTC
  1.  S M=M+1,^TMP(PROG,$J,M)="Completed EFT file at "_$$FMTE^XLFDT(%)
  1.  S M=M+1,^TMP(PROG,$J,M)="Count of records in EFT file - "_(I-1)
  1.  S M=M+1,^TMP(PROG,$J,M)="Count of fields moved        - "_+C
  1.  Q
  1.  ;
  1.  ;
  1. MOVEERA ;Move existing ERA (File #344.4) field to new global node
  1.  ;
  1.  ;Moves field CHECK# (.13)
  1.  ;from ^RCY(344.4,D0,0) piece 13
  1.  ;to ^RCY(344.4,D0,5) piece 2
  1.  ;
  1.  ;
  1.  N %,C,I,N,VALUE,X
  1.  S C=0
  1.  ;Update mail message
  1.  D NOW^%DTC
  1.  S M=M+1,^TMP(PROG,$J,M)="Started ERA file at "_$$FMTE^XLFDT(%)
  1.  ;Scan file moving non-null fields only into ^XTMP and new location
  1.  ;and clear field in original location
  1.  S N=0 F I=1:1 S N=$O(^RCY(344.4,N)) Q:'N  S VALUE=$P($G(^RCY(344.4,N,0)),U,13) I VALUE]"" S C=C+1,^XTMP(PROG,"ERA",C)=VALUE_U_N,$P(^RCY(344.4,N,5),U,2)=VALUE,$P(^RCY(344.4,N,0),U,13)=""
  1.  ;Completion time
  1.  D NOW^%DTC
  1.  S M=M+1,^TMP(PROG,$J,M)="Completed ERA file at "_$$FMTE^XLFDT(%)
  1.  S M=M+1,^TMP(PROG,$J,M)="Count of records in ERA file - "_(I-1)
  1.  S M=M+1,^TMP(PROG,$J,M)="Count of fields moved        - "_+C
  1.  Q
  1.  ;
  1. MOVEERA1 ;Move existing ERA (File #344.41) field to new global node
  1.  ;
  1.  ;Moves field REN PROV COMMENT (#.23)
  1.  ;from ^RCY(344.4,D0,1,D1,3) piece 5
  1.  ;to ^RCY(344.4,D0,1,D1,4) piece 1
  1.  ;
  1.  ;
  1.  N %,C,I,N,N1,VALUE,X
  1.  S C=0
  1.  ;Update mail message
  1.  D NOW^%DTC
  1.  S M=M+1,^TMP(PROG,$J,M)="Started ERA,1 file at "_$$FMTE^XLFDT(%)
  1.  ;Scan file moving non-null fields only into ^XTMP and new location
  1.  ;and clear field in original location
  1.  S N=0,I=0
  1.  F  S N=$O(^RCY(344.4,N)) Q:'N  S N1=0 D
  1.  .F  S N1=$O(^RCY(344.4,N,1,N1)) Q:'N1  D
  1.  ..S I=I+1,VALUE=$P($G(^RCY(344.4,N,1,N1,3)),U,5) I VALUE]"" S C=C+1,^XTMP(PROG,"ERA1",C)=VALUE_U_N_U_N1,^RCY(344.4,N,1,N1,4)=VALUE,$P(^RCY(344.4,N,1,N1,3),U,5)=""
  1.  ;Completion time
  1.  D NOW^%DTC
  1.  S M=M+1,^TMP(PROG,$J,M)="Completed ERA,1 file at "_$$FMTE^XLFDT(%)
  1.  S M=M+1,^TMP(PROG,$J,M)="Count of records in ERA,1 file - "_+I
  1.  S M=M+1,^TMP(PROG,$J,M)="Count of fields moved          - "_+C
  1.  Q
  1.  ;
  1. MOVEERA2 ;Move existing ERA (File #344.42) field to new global node
  1.  ;
  1.  ;Moves field ADJUSTMENT TEXT (#.04)
  1.  ;from ^RCY(344.4,D0,2,D1,0) piece 4
  1.  ;to ^RCY(344.4,D0,2,D1,1) piece 1
  1.  ;
  1.  ;
  1.  N %,C,I,N,N1,VALUE,X
  1.  S C=0
  1.  ;Update mail message
  1.  D NOW^%DTC
  1.  S M=M+1,^TMP(PROG,$J,M)="Started ERA,2 file at "_$$FMTE^XLFDT(%)
  1.  ;Scan file moving non-null fields only into ^XTMP and new location
  1.  ;and clear field in original location
  1.  S N=0,I=0
  1.  F  S N=$O(^RCY(344.4,N)) Q:'N  S N1=0 D
  1.  .F  S N1=$O(^RCY(344.4,N,2,N1)) Q:'N1  D
  1.  ..S I=I+1,VALUE=$P($G(^RCY(344.4,N,2,N1,0)),U,4) I VALUE]"" S C=C+1,^XTMP(PROG,"ERA2",C)=VALUE_U_N_U_N1,^RCY(344.4,N,2,N1,1)=VALUE,$P(^RCY(344.4,N,2,N1,0),U,4)=""
  1.  ;Completion time
  1.  D NOW^%DTC
  1.  ;Also update XTMP as complete
  1.  S $P(^XTMP(PROG,0),U,4)=X
  1.  S M=M+1,^TMP(PROG,$J,M)="Completed ERA,2 file at "_$$FMTE^XLFDT(%)
  1.  S M=M+1,^TMP(PROG,$J,M)="Count of records in ERA,2 file - "_+I
  1.  S M=M+1,^TMP(PROG,$J,M)="Count of fields moved          - "_+C
  1.  Q