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

PRCAI170.m

Go to the documentation of this file. 
  1. PRCAI170 ;WISC/RFJ-post init patch 170 ; 26 Jan 01
  1.  ;;4.5;Accounts Receivable;**170**;Mar 20, 1995
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  Q
  1.  ;
  1.  ;
  1. PREINIT ;  start pre init, check to make sure entries can be added to 430.2
  1.  N %,CURDATA,NEWDATA,RCERROR
  1.  ;
  1.  D BMES^XPDUTL(" >>  Starting the Pre-Initialization routine ...")
  1.  D MES^XPDUTL("     -> Checking file 430.2 prior to adding new entries ...")
  1.  ;
  1.  ;  check 430.2 entries and verify the new ones can be added
  1.  S RCERROR=0
  1.  F %=33:1:39 S CURDATA=$G(^PRCA(430.2,%,0)) I CURDATA'="" S NEWDATA=$P($T(@%),";",3,99) I $P(CURDATA,"^")'=$P(NEWDATA,"^") S RCERROR=1
  1.  ;
  1.  ;  cannot install patch
  1.  I RCERROR S XPDQUIT=1 D MES^XPDUTL("        WARNING: FILE 430.2 IS CORRUPT.  UNABLE TO INSTALL PATCH."),MES^XPDUTL("        PLEASE LOG A NOIS.")
  1.  I 'RCERROR D MES^XPDUTL("        Everything is OK!")
  1.  ;
  1.  D MES^XPDUTL(" >>  End of the Pre-Initialization routine.")
  1.  Q
  1.  ;
  1.  ;
  1. POSTINIT ;  start post init
  1.  N %,D,D0,DA,DI,DIC,DIE,DIK,DINUM,DLAYGO,DQ,DR,RCDATA,RCDINUM,X,Y
  1.  ;
  1.  D BMES^XPDUTL(" >>  Starting the Post-Initialization routine ...")
  1.  D MES^XPDUTL("     -> Adding new AR Category entries to file 430.2 ...")
  1.  ;
  1.  ;  install entries in file 430.2
  1.  F RCDINUM=33:1:39 D
  1.  .   S RCDATA=$P($T(@RCDINUM),";",3,99)
  1.  .   S (DIC,DIE)="^PRCA(430.2,",DIC(0)="L",DLAYGO=430.2
  1.  .   ;
  1.  .   ;  if the entry is in the file, delete it first to add fields uneditable
  1.  .   I $D(^PRCA(430.2,RCDINUM,0)) S DIK="^PRCA(430.2,",DA=RCDINUM D ^DIK
  1.  .   ;
  1.  .   ;  add entry
  1.  .   S DINUM=RCDINUM
  1.  .   S X=$P(RCDATA,"^")
  1.  .   D FILE^DICN
  1.  .   ;
  1.  .   ;  set the fields
  1.  .   S DA=RCDINUM
  1.  .   S DR="1///"_$P(RCDATA,"^",2)_";2////0;3///1319;5///P;"
  1.  .   ;  category number (add this to activation patch)
  1.  .   S DR=DR_"6////"_$P(RCDATA,"^",3)_";"
  1.  .   S DR=DR_"7///2;9///1;10///1;11///1;12///1;13///2;"
  1.  .   ;  paragraph notes
  1.  .   S DR=DR_"14///30,40,55,80,85,50,60,65,70;"
  1.  .   D ^DIE
  1.  ;
  1.  D MES^XPDUTL("        OK, I'm done!")
  1.  D MES^XPDUTL(" >>  End of the Post-Initialization routine ...")
  1.  Q
  1.  ;
  1.  ;
  1.  ;;categoryname ^ abbreviation ^ category number
  1. 33 ;;ADULT DAY HEALTH CARE^AD^0
  1. 34 ;;DOMICILIARY^DO^0
  1. 35 ;;RESPITE CARE-INSTITUTIONAL^RC^0
  1. 36 ;;RESPITE CARE-NON-INSTITUTIONAL^RN^0
  1. 37 ;;GERIATRIC EVAL-INSTITUTIONAL^GE^0
  1. 38 ;;GERIATRIC EVAL-NON-INSTITUTION^GN^0
  1. 39 ;;NURSING HOME CARE-LTC^NL^0
  1.  ;
  1.  ;
  1.  ;
  1.  ;  comments for the patch to activate the ltc categories
  1.  ;  create a post init that will set field 6 in file 430.2
  1.  ;  which is the category number as it is shown below.
  1.  ;;categoryname ^ abbreviation ^ category number
  1.  ;;ADULT DAY HEALTH CARE^AD^40
  1.  ;;DOMICILIARY^DO^41
  1.  ;;RESPITE CARE-INSTITUTIONAL^RC^42
  1.  ;;RESPITE CARE-NON-INSTITUTIONAL^RN^43
  1.  ;;GERIATRIC EVAL-INSTITUTIONAL^GE^44
  1.  ;;GERIATRIC EVAL-NON-INSTITUTION^GN^45
  1.  ;;NURSING HOME CARE-LTC^NL^46