- PRCIN45 ;BP-OIFO/SWS-IFCAP UTILITY TO CLEAN UP BAD LINKS IN FILE 445 TO 410 ;12/07/2005 12:16
- V ;;5.1;IFCAP;**95**;Oct 20, 2000
- Q
- START S IPIEN=0,NREC=0,TREC=0
- S ^XTMP("IFCAP-PURGE-445",0)=$$FMADD^XLFDT(DT,7)_"^"_DT_"^RECORDS PURGED FROM FILE 445 BY PRC*5.1*95"
- S ^XTMP("IFCAP-PURGE-445-REF",0)=$$FMADD^XLFDT(DT,7)_"^"_DT_"^B CROSS REFERENCES PURGED FROM FILE 445 BY PRC*5.1*95"
- F S IPIEN=$O(^PRCP(445,IPIEN)) Q:IPIEN'>0 D
- .S IEN=0
- .F S IEN=$O(^PRCP(445,IPIEN,1,IEN)) Q:IEN'>0 D
- ..S TREC=TREC+1
- ..Q:'$D(^PRCP(445,IPIEN,1,IEN,7))
- ..S TTLI=$P(^PRCP(445,IPIEN,1,IEN,7,0),U,4)
- ..S ITIEN=0
- ..F S ITIEN=$O(^PRCP(445,IPIEN,1,IEN,7,ITIEN)) Q:ITIEN'>0 D
- ...I '$D(^PRCS(410,ITIEN)) D KILL445
- ..S $P(^PRCP(445,IPIEN,1,IEN,7,0),U,4)=TTLI
- ..;-leave this with zero amount don't delete? - I TTLI=0 S ^PRCP(445,IPIEN,1,IEN,7) Q
- ..Q
- .Q
- D WTOTAL,CLEAN
- Q
- WTOTAL ;
- D BMES^XPDUTL(NREC_" RECORDS DELETED FROM FILE 445")
- D BMES^XPDUTL("BACKUP RECORDS STORED IN THE FOLLOWING LOCATIONS FOR 7 DAYS:")
- D BMES^XPDUTL("^XTMP(""IFCAP-PURGE-445"")")
- D BMES^XPDUTL("^XTMP(""IFCAP-PURGE-445-REF"")")
- Q
- KILL445 ;set temp files then kill invalid 445 records
- S NREC=NREC+1
- S ^XTMP("IFCAP-PURGE-445",IPIEN,1,IEN,7,ITIEN,0)=^PRCP(445,IPIEN,1,IEN,7,ITIEN,0)
- S ^XTMP("IFCAP-PURGE-445-REF",IPIEN,1,IEN,7,"B",ITIEN,ITIEN)="B^"_ITIEN_"^"_ITIEN
- Q:'$D(^PRCP(445,IPIEN,1,IEN,7,ITIEN,0))
- S DA(2)=IPIEN,DA(1)=IEN,DA=ITIEN
- S DIK="^PRCP(445,"_DA(2)_",1,"_DA(1)_",7,"
- D ^DIK
- K DIK
- S TTLI=TTLI-1
- Q
- CLEAN K TTLI,IEN,IPIEN,ITIEN,TREC,NREC
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCIN45 1573 printed Dec 13, 2024@02:11:30 Page 2
- PRCIN45 ;BP-OIFO/SWS-IFCAP UTILITY TO CLEAN UP BAD LINKS IN FILE 445 TO 410 ;12/07/2005 12:16
- V ;;5.1;IFCAP;**95**;Oct 20, 2000
- +1 QUIT
- START SET IPIEN=0
- SET NREC=0
- SET TREC=0
- +1 SET ^XTMP("IFCAP-PURGE-445",0)=$$FMADD^XLFDT(DT,7)_"^"_DT_"^RECORDS PURGED FROM FILE 445 BY PRC*5.1*95"
- +2 SET ^XTMP("IFCAP-PURGE-445-REF",0)=$$FMADD^XLFDT(DT,7)_"^"_DT_"^B CROSS REFERENCES PURGED FROM FILE 445 BY PRC*5.1*95"
- +3 FOR
- SET IPIEN=$ORDER(^PRCP(445,IPIEN))
- if IPIEN'>0
- QUIT
- Begin DoDot:1
- +4 SET IEN=0
- +5 FOR
- SET IEN=$ORDER(^PRCP(445,IPIEN,1,IEN))
- if IEN'>0
- QUIT
- Begin DoDot:2
- +6 SET TREC=TREC+1
- +7 if '$DATA(^PRCP(445,IPIEN,1,IEN,7))
- QUIT
- +8 SET TTLI=$PIECE(^PRCP(445,IPIEN,1,IEN,7,0),U,4)
- +9 SET ITIEN=0
- +10 FOR
- SET ITIEN=$ORDER(^PRCP(445,IPIEN,1,IEN,7,ITIEN))
- if ITIEN'>0
- QUIT
- Begin DoDot:3
- +11 IF '$DATA(^PRCS(410,ITIEN))
- DO KILL445
- End DoDot:3
- +12 SET $PIECE(^PRCP(445,IPIEN,1,IEN,7,0),U,4)=TTLI
- +13 ;-leave this with zero amount don't delete? - I TTLI=0 S ^PRCP(445,IPIEN,1,IEN,7) Q
- +14 QUIT
- End DoDot:2
- +15 QUIT
- End DoDot:1
- +16 DO WTOTAL
- DO CLEAN
- +17 QUIT
- WTOTAL ;
- +1 DO BMES^XPDUTL(NREC_" RECORDS DELETED FROM FILE 445")
- +2 DO BMES^XPDUTL("BACKUP RECORDS STORED IN THE FOLLOWING LOCATIONS FOR 7 DAYS:")
- +3 DO BMES^XPDUTL("^XTMP(""IFCAP-PURGE-445"")")
- +4 DO BMES^XPDUTL("^XTMP(""IFCAP-PURGE-445-REF"")")
- +5 QUIT
- KILL445 ;set temp files then kill invalid 445 records
- +1 SET NREC=NREC+1
- +2 SET ^XTMP("IFCAP-PURGE-445",IPIEN,1,IEN,7,ITIEN,0)=^PRCP(445,IPIEN,1,IEN,7,ITIEN,0)
- +3 SET ^XTMP("IFCAP-PURGE-445-REF",IPIEN,1,IEN,7,"B",ITIEN,ITIEN)="B^"_ITIEN_"^"_ITIEN
- +4 if '$DATA(^PRCP(445,IPIEN,1,IEN,7,ITIEN,0))
- QUIT
- +5 SET DA(2)=IPIEN
- SET DA(1)=IEN
- SET DA=ITIEN
- +6 SET DIK="^PRCP(445,"_DA(2)_",1,"_DA(1)_",7,"
- +7 DO ^DIK
- +8 KILL DIK
- +9 SET TTLI=TTLI-1
- +10 QUIT
- CLEAN KILL TTLI,IEN,IPIEN,ITIEN,TREC,NREC
- +1 QUIT
- +2 ;