PRCA355P ;ALB/JSG - PATCH PRCA*4.5*355 PRE/POST-INSTALL ROUTINE ;5/28/19 6:22pm
;;4.5;Accounts Receivable;**355**;Mar 20, 1995;Build 10
;;Per VA Directive 6402, this routine should not be modified.
;
; DBIA#10141
;
Q
;
BMSG(MESS) ; spit out message (preceded by a blank line
D BMES^XPDUTL(MESS)
Q
;
POSTINS ;
Q:($$PROD^XUPROD(1))&($$INSTALDT^XPDUTL("PRCA*4.5*355")) ; DBIA#10141
D CHGSTDAY ; Change statement day
;
Q
;
CHGSTDAY ; Change statement day
;
; Get the statement day
N DOM
S DOM=$$GETDOM
Q:DOM=0 ; Not one of the 16 sites needing new statement day
D BMSG("Reset Site Parameter - SITE STATEMENT DAY to "_DOM)
N DA,DR,DIE,X,RCT
S DIE="^RC(342,"
S DA=1
S DR=".11///"_DOM ; Stuff field value (Validated)
D ^DIE
;
; set of Patient Statement Day dependent upon site (must be a patient - DPT)
D BMES^XPDUTL("Resetting Patient Statement Day to "_DOM)
N DEBT,DIE
S DIE="^RCD(340,"
S DEBT=""
F S DEBT=$O(^RCD(340,"AB","DPT(",DEBT)) Q:DEBT="" D
. N DA,DR
. S DA=DEBT
. S DR=".03////"_DOM ; Stuff field value (Unvalidated)
. D ^DIE
Q
;
GETDOM() ; Get site and statement day
; Input: None
;
; Output: New statement day or flag
; 0 - Flag for sites that do not need to get new statement day
; 26 - New statement day for 10 selected sites
; 28 - New statement day for 6 selected sites
;
N FLG,SITE,SITES26,SITES28
S SITE=+$$SITE^VASITE
S SITES26=$P($T(SITES26),";",3)
S SITES28=$P($T(SITES28),";",3)
S FLG=$S(SITES26[(","_SITE_","):26,SITES28[(","_SITE_","):28,1:0)
Q FLG
;
; From PRCA*4.5*355 Patch Description:
;
; Sites with new statement day = 26
SITES26 ;;,438,501,504,542,562,568,649,656,688,756,
;
; Sites with new statement day = 28
SITES28 ;;,565,621,658,664,671,740,
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCA355P 1814 printed Dec 13, 2024@01:38:45 Page 2
PRCA355P ;ALB/JSG - PATCH PRCA*4.5*355 PRE/POST-INSTALL ROUTINE ;5/28/19 6:22pm
+1 ;;4.5;Accounts Receivable;**355**;Mar 20, 1995;Build 10
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; DBIA#10141
+5 ;
+6 QUIT
+7 ;
BMSG(MESS) ; spit out message (preceded by a blank line
+1 DO BMES^XPDUTL(MESS)
+2 QUIT
+3 ;
POSTINS ;
+1 ; DBIA#10141
if ($$PROD^XUPROD(1))&($$INSTALDT^XPDUTL("PRCA*4.5*355"))
QUIT
+2 ; Change statement day
DO CHGSTDAY
+3 ;
+4 QUIT
+5 ;
CHGSTDAY ; Change statement day
+1 ;
+2 ; Get the statement day
+3 NEW DOM
+4 SET DOM=$$GETDOM
+5 ; Not one of the 16 sites needing new statement day
if DOM=0
QUIT
+6 DO BMSG("Reset Site Parameter - SITE STATEMENT DAY to "_DOM)
+7 NEW DA,DR,DIE,X,RCT
+8 SET DIE="^RC(342,"
+9 SET DA=1
+10 ; Stuff field value (Validated)
SET DR=".11///"_DOM
+11 DO ^DIE
+12 ;
+13 ; set of Patient Statement Day dependent upon site (must be a patient - DPT)
+14 DO BMES^XPDUTL("Resetting Patient Statement Day to "_DOM)
+15 NEW DEBT,DIE
+16 SET DIE="^RCD(340,"
+17 SET DEBT=""
+18 FOR
SET DEBT=$ORDER(^RCD(340,"AB","DPT(",DEBT))
if DEBT=""
QUIT
Begin DoDot:1
+19 NEW DA,DR
+20 SET DA=DEBT
+21 ; Stuff field value (Unvalidated)
SET DR=".03////"_DOM
+22 DO ^DIE
End DoDot:1
+23 QUIT
+24 ;
GETDOM() ; Get site and statement day
+1 ; Input: None
+2 ;
+3 ; Output: New statement day or flag
+4 ; 0 - Flag for sites that do not need to get new statement day
+5 ; 26 - New statement day for 10 selected sites
+6 ; 28 - New statement day for 6 selected sites
+7 ;
+8 NEW FLG,SITE,SITES26,SITES28
+9 SET SITE=+$$SITE^VASITE
+10 SET SITES26=$PIECE($TEXT(SITES26),";",3)
+11 SET SITES28=$PIECE($TEXT(SITES28),";",3)
+12 SET FLG=$SELECT(SITES26[(","_SITE_","):26,SITES28[(","_SITE_","):28,1:0)
+13 QUIT FLG
+14 ;
+15 ; From PRCA*4.5*355 Patch Description:
+16 ;
+17 ; Sites with new statement day = 26
SITES26 ;;,438,501,504,542,562,568,649,656,688,756,
+1 ;
+2 ; Sites with new statement day = 28
SITES28 ;;,565,621,658,664,671,740,
