Changeset 636 for FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR8PG.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR8PG.m
r628 r636 1 1 RMPR8PG ;PHX,HOIFO/JLT,SPS-PURGE 668 SUSPENSE FILE ;8/29/1994 2 ;;3.0;PROSTHETICS;**5,75 ,140**;Feb 09, 1996;Build 102 ;;3.0;PROSTHETICS;**5,75**;Feb 09, 1996;Build 25 3 3 ; 4 4 ;02/03/06 Added code to delete the pointer in 664.1 field .05 when a … … 14 14 S DIS(0)="I $P(^RMPR(668,D0,0),U,7)=RMPR(""STA"")",IOP=ION,DIC="^RMPR(668,",FLDS=".01;C1,1;C20;L17,2,3,6;C45;L15,5;C65,4;C1,7;C1",BY="5",FR=$S($D(^RMPR(668,"B")):$O(^RMPR(668,"B","")),1:2890101) 15 15 S TO=RMPRDT,DHD="Purge Suspense File Entries from Station/Division "_RMPR("STA") D EN1^DIP 16 N RMPR664117 16 F S RMPRIEN=$O(^RMPR(668,RMPRIEN)) Q:RMPRIEN'>0 I $P($G(^RMPR(668,RMPRIEN,0)),U,7)=RMPR("STA") I ($P(^RMPR(668,RMPRIEN,0),U,5))&($P(^(0),U,5)<RMPRDT) S DA=RMPRIEN,DIC="^RMPR(668," S DA=RMPRIEN,DIK=DIC D ^DIK D S RDEL=RDEL+1 18 . S RMPR6641=0F S RMPR6641=$O(^RMPR(664.1,"SUS",DA,RMPR6641)) Q:RMPR6641'>0 D17 . F S RMPR6641=$O(^RMPR(664.1,"SUS",DA,RMPR6641)) Q:RMPR6641'>0 D 19 18 .. I $D(^RMPR(664.1,RMPR6641,0)) S $P(^(0),U,8)="" 20 19 END I $G(RDEL)<1 W !!,"No Suspense entries purged." … … 22 21 I $G(RDEL)=1 W !!,RDEL,"Suspense entry purged. " 23 22 EXIT ;common exit point 24 K I,RD,X,DIS,%ZIS,X1,X2,RMPRIEN,RMPRDT,R MPR6641,RDEL,DIC,DIK,DA,RL,BY,DHD,DHIT,FLDS,FR,TO D ^%ZISC Q23 K I,RD,X,DIS,%ZIS,X1,X2,RMPRIEN,RMPRDT,RDEL,DIC,DIK,DA,RL,BY,DHD,DHIT,FLDS,FR,TO D ^%ZISC Q
Note:
See TracChangeset
for help on using the changeset viewer.