| 1 | RC45P252 ;ALB/CLT - PATCH PRCA*4.5*252 POST INIT ROUTINE ;13-JUN-2008
|
|---|
| 2 | ;;4.5;Accounts Receivable;**252**;Mar 20, 1995;Build 63
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; Review all entries in file 344.4 looking for any IDENTITY TYPE QUALIFIER fields
|
|---|
| 6 | ; that contain a zero (0). If the field is equal to 0, change it to NULL
|
|---|
| 7 | ;
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | EN ;
|
|---|
| 11 | D MESSAGE("Queuing PRCA*4.5*252 POST-INSTALL process")
|
|---|
| 12 | N %DT,X,Y,ZTDESC,ZTSAVE,ZTIO,ZTDTH,ZTRTN
|
|---|
| 13 | S X="N",%DT="ST"
|
|---|
| 14 | D ^%DT
|
|---|
| 15 | S ZTDTH=Y
|
|---|
| 16 | S ZTIO=""
|
|---|
| 17 | S ZTDESC="PRCA*4.5*252 POST INSTALL PROCESS"
|
|---|
| 18 | S ZTSAVE("DUZ")=""
|
|---|
| 19 | S ZTRTN="EN1^RC45P252"
|
|---|
| 20 | D ^%ZTLOAD
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | EN1 ;PRIMARY ENTRY POINT
|
|---|
| 24 | N RCDPX,RCDPY,RCDPZ1,RCDPZ2,RCDPZ3,RCDPMSG1,RCDPMSG2,RCDPMSG3 ;variables used in the search
|
|---|
| 25 | S (RCDPX,RCDPZ1,RCDPZ2,RCDPZ3)=0 ;Initial value setup
|
|---|
| 26 | F S RCDPX=$O(^RCY(344.4,RCDPX)) Q:'+RCDPX S RCDPZ1=RCDPZ1+1 S RCDPY=0 D
|
|---|
| 27 | . 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))
|
|---|
| 28 | . . 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
|
|---|
| 29 | S RCDPMSG1=RCDPZ1_" ERA records have been reviewed"
|
|---|
| 30 | S RCDPMSG2=RCDPZ2_" ERA details have been reviewed"
|
|---|
| 31 | S RCDPMSG3=RCDPZ3_" ERA details have been corrected"
|
|---|
| 32 | D SNDMAIL("PRCA*4.5*252 installation has been completed",RCDPMSG1,RCDPMSG2,RCDPMSG3)
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | ; RCDPMSG - message text
|
|---|
| 36 | MESSAGE(RCDPMSG) ;
|
|---|
| 37 | D BMES^XPDUTL(RCDPMSG)
|
|---|
| 38 | Q
|
|---|
| 39 | ; Send mail to the user
|
|---|
| 40 | SNDMAIL(RCDPSUBJ,RCDPM1,RCDPM2,RCDPM3) ;
|
|---|
| 41 | N DIFROM
|
|---|
| 42 | N RCDPARR,XMDUZ,XMSUB,XMTEXT,XMY,RCDPUSR,XMZ,XMMG
|
|---|
| 43 | S RCDPARR(1)=""
|
|---|
| 44 | S RCDPARR(2)=RCDPM1
|
|---|
| 45 | S RCDPARR(3)=RCDPM2
|
|---|
| 46 | S RCDPARR(4)=RCDPM3
|
|---|
| 47 | S RCDPARR(5)=""
|
|---|
| 48 | S XMSUB=RCDPSUBJ
|
|---|
| 49 | S XMDUZ="ACCOUNTS RECEIVABLE - PRCA*4.5*252 POST INSTALL"
|
|---|
| 50 | S XMTEXT="RCDPARR("
|
|---|
| 51 | S RCDPUSR=$S($G(DUZ)']"":.5,1:DUZ)
|
|---|
| 52 | S XMY(RCDPUSR)=""
|
|---|
| 53 | D ^XMD
|
|---|
| 54 | Q
|
|---|
