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

RC45P252.m

Go to the documentation of this file.
RC45P252 ;ALB/CLT - PATCH PRCA*4.5*252 POST INIT ROUTINE ;13-JUN-2008
 ;;4.5;Accounts Receivable;**252**;Mar 20, 1995;Build 63
 ;;Per VHA Directive 2004-038, this routine should not be modified.
 ;
 ; Review all entries in file 344.4 looking for any IDENTITY TYPE QUALIFIER fields
 ; that contain a zero (0).  If the field is equal to 0, change it to NULL
 ; 
 Q
 ;
EN ;
 D MESSAGE("Queuing PRCA*4.5*252 POST-INSTALL process")
 N %DT,X,Y,ZTDESC,ZTSAVE,ZTIO,ZTDTH,ZTRTN
 S X="N",%DT="ST"
 D ^%DT
 S ZTDTH=Y
 S ZTIO=""
 S ZTDESC="PRCA*4.5*252 POST INSTALL PROCESS"
 S ZTSAVE("DUZ")=""
 S ZTRTN="EN1^RC45P252"
 D ^%ZTLOAD
 Q
 ;
EN1 ;PRIMARY ENTRY POINT
 N RCDPX,RCDPY,RCDPZ1,RCDPZ2,RCDPZ3,RCDPMSG1,RCDPMSG2,RCDPMSG3  ;variables used in the search
 S (RCDPX,RCDPZ1,RCDPZ2,RCDPZ3)=0  ;Initial value setup
 F  S RCDPX=$O(^RCY(344.4,RCDPX)) Q:'+RCDPX  S RCDPZ1=RCDPZ1+1 S RCDPY=0 D
 . F  S RCDPY=$O(^RCY(344.4,RCDPX,1,RCDPY))  Q:'+RCDPY  S RCDPZ2=RCDPZ2+1 D:$D(^RCY(344.4,RCDPX,1,RCDPY,3))
 . .  I $P(^RCY(344.4,RCDPX,1,RCDPY,3),U,3)=0 S $P(^RCY(344.4,RCDPX,1,RCDPY,3),U,3)="" S RCDPZ3=RCDPZ3+1
 S RCDPMSG1=RCDPZ1_" ERA records have been reviewed"
 S RCDPMSG2=RCDPZ2_" ERA details have been reviewed"
 S RCDPMSG3=RCDPZ3_" ERA details have been corrected"
 D SNDMAIL("PRCA*4.5*252 installation has been completed",RCDPMSG1,RCDPMSG2,RCDPMSG3)
 Q
 ;
 ; RCDPMSG - message text
MESSAGE(RCDPMSG) ;
 D BMES^XPDUTL(RCDPMSG)
 Q
 ; Send mail to the user
SNDMAIL(RCDPSUBJ,RCDPM1,RCDPM2,RCDPM3) ;
 N DIFROM
 N RCDPARR,XMDUZ,XMSUB,XMTEXT,XMY,RCDPUSR,XMZ,XMMG
 S RCDPARR(1)=""
 S RCDPARR(2)=RCDPM1
 S RCDPARR(3)=RCDPM2
 S RCDPARR(4)=RCDPM3
 S RCDPARR(5)=""
 S XMSUB=RCDPSUBJ
 S XMDUZ="ACCOUNTS RECEIVABLE - PRCA*4.5*252 POST INSTALL"
 S XMTEXT="RCDPARR("
 S RCDPUSR=$S($G(DUZ)']"":.5,1:DUZ)
 S XMY(RCDPUSR)=""
 D ^XMD
 Q