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

PRCIN45.m

Go to the documentation of this file.
  1. PRCIN45 ;BP-OIFO/SWS-IFCAP UTILITY TO CLEAN UP BAD LINKS IN FILE 445 TO 410 ;12/07/2005 12:16
  1. V ;;5.1;IFCAP;**95**;Oct 20, 2000
  1. Q
  1. START S IPIEN=0,NREC=0,TREC=0
  1. S ^XTMP("IFCAP-PURGE-445",0)=$$FMADD^XLFDT(DT,7)_"^"_DT_"^RECORDS PURGED FROM FILE 445 BY PRC*5.1*95"
  1. S ^XTMP("IFCAP-PURGE-445-REF",0)=$$FMADD^XLFDT(DT,7)_"^"_DT_"^B CROSS REFERENCES PURGED FROM FILE 445 BY PRC*5.1*95"
  1. F S IPIEN=$O(^PRCP(445,IPIEN)) Q:IPIEN'>0 D
  1. .S IEN=0
  1. .F S IEN=$O(^PRCP(445,IPIEN,1,IEN)) Q:IEN'>0 D
  1. ..S TREC=TREC+1
  1. ..Q:'$D(^PRCP(445,IPIEN,1,IEN,7))
  1. ..S TTLI=$P(^PRCP(445,IPIEN,1,IEN,7,0),U,4)
  1. ..S ITIEN=0
  1. ..F S ITIEN=$O(^PRCP(445,IPIEN,1,IEN,7,ITIEN)) Q:ITIEN'>0 D
  1. ...I '$D(^PRCS(410,ITIEN)) D KILL445
  1. ..S $P(^PRCP(445,IPIEN,1,IEN,7,0),U,4)=TTLI
  1. ..;-leave this with zero amount don't delete? - I TTLI=0 S ^PRCP(445,IPIEN,1,IEN,7) Q
  1. ..Q
  1. .Q
  1. D WTOTAL,CLEAN
  1. Q
  1. WTOTAL ;
  1. D BMES^XPDUTL(NREC_" RECORDS DELETED FROM FILE 445")
  1. D BMES^XPDUTL("BACKUP RECORDS STORED IN THE FOLLOWING LOCATIONS FOR 7 DAYS:")
  1. D BMES^XPDUTL("^XTMP(""IFCAP-PURGE-445"")")
  1. D BMES^XPDUTL("^XTMP(""IFCAP-PURGE-445-REF"")")
  1. Q
  1. KILL445 ;set temp files then kill invalid 445 records
  1. S NREC=NREC+1
  1. S ^XTMP("IFCAP-PURGE-445",IPIEN,1,IEN,7,ITIEN,0)=^PRCP(445,IPIEN,1,IEN,7,ITIEN,0)
  1. S ^XTMP("IFCAP-PURGE-445-REF",IPIEN,1,IEN,7,"B",ITIEN,ITIEN)="B^"_ITIEN_"^"_ITIEN
  1. Q:'$D(^PRCP(445,IPIEN,1,IEN,7,ITIEN,0))
  1. S DA(2)=IPIEN,DA(1)=IEN,DA=ITIEN
  1. S DIK="^PRCP(445,"_DA(2)_",1,"_DA(1)_",7,"
  1. D ^DIK
  1. K DIK
  1. S TTLI=TTLI-1
  1. Q
  1. CLEAN K TTLI,IEN,IPIEN,ITIEN,TREC,NREC
  1. Q
  1. ;