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

PRCN11PO.m

Go to the documentation of this file.
  1. PRCN11PO ;WISC/CW-post init patch 11 ;08-Nov-02
  1. ;;1.0;Equipment/Turn-In Request;**11**;Sep 13, 1996
  1. Q
  1. POST ;start post init
  1. ;add line item count to file 410 if record contains line items
  1. ;
  1. N U,PRCNUM,PRCNIMP,PRCNLIC,PRCNFND,PRCNDA1,PRCNDA2
  1. D BMES^XPDUTL(" >> Starting the Post-Initialization routine ...")
  1. D MES^XPDUTL(" -> Adding LINE ITEM COUNT to file 410 ...")
  1. ;
  1. S U="^",(PRCNDA1,PRCNFND,PRCNUM)=0
  1. F S PRCNDA1=$O(^PRCN(413,PRCNDA1)) Q:'PRCNDA1 D
  1. . S PRCNIMP=$P($G(^PRCN(413,PRCNDA1,0)),U,7)
  1. . ;request status in file 413.5 ;19-Approved-Funded
  1. . ;39-Ready for 2237 Processing ;18-Approved-Pending Funding
  1. . I (PRCNIMP'=39),(PRCNIMP'=18),(PRCNIMP'=19) Q
  1. . S PRCNIMP=$P(^PRCN(413,PRCNDA1,0),U)
  1. . S PRCNDA2=$O(^PRCS(410,"H",PRCNIMP,""))
  1. . Q:PRCNDA2=""
  1. . Q:'$D(^PRCS(410,PRCNDA2,"IT",1))
  1. . Q:'$D(^PRCS(410,PRCNDA2,10))
  1. . Q:$P(^PRCS(410,PRCNDA2,10),U)
  1. . S PRCNFND=1
  1. . S PRCNLIC=$O(^PRCS(410,PRCNDA2,"IT",99),-1),PRCNUM=PRCNUM+1
  1. . S ^PRCS(410,PRCNDA2,10)=PRCNLIC_U_$P(^PRCS(410,PRCNDA2,10),U,2,99)
  1. . W !!,PRCNUM_". "_"LINE ITEM COUNT "_PRCNLIC_" has been added to the entry record "_PRCNDA2_".",!
  1. ;
  1. I 'PRCNFND D MES^XPDUTL(" No records need to be updated!")
  1. D MES^XPDUTL(" >> End of the Post-Initialization routine ...")
  1. Q