- A4A7CLUP ;SFISC/RWF - CLEAN UP THE NEW PERSON FILE FOF ;12/27/90 16:25
- ;;1;;
- A I $G(DUZ(0))'="@" W !!,*7,"You must have VA FileMan Programmer access" Q
- W !!,"This routine will check and see if your site is using the new File Access",!,"method for VA FileMan. If not it will let you remove the fields in the "
- W !,"New Person and User file that could change the access method by accident"
- N I $D(^DD(200,0))[0 W !!,"You don't have a New Person file" G USER
- I $D(^DD(200.032,0))=0 G USER
- I $D(^VA(200,"AFOF")) W !!,*7,"You have data in your File 200 'AFOF' X-ref. This means that you are using the",!,"'ACCESSIBLE FILE' access." G USER
- W !!,"Your NEW PERSON file has the 'ACCESSIBLE FILE' field:"
- S DIR("A")="Remove 'ACCESSIBLE FILE' field",DIR(0)="Y" D ^DIR G PROV:$D(DIRUT)
- I Y=1 S DIU=200.032,DIU(0)="SD" D EN^DIU2
- USER ;
- I '$D(^DIC(3,"AFOF")) G U2
- W !!,*7,"You have data in your File 3 'AFOF' X-ref. This means that you are using the",!,"'ACCESSIBLE FILE' access."
- W !,"You must remove this FIRST if you want to run this option." G PROV
- U2 ;
- I $D(^DD(3.032,0))=0 W !,"You don't have the 'ACCESSIBLE FILE' field in your user file." G PROV
- W !!,"Your USER file has the 'ACCESSIBLE FILE' field:"
- S DIR("A")="Remove 'ACCESSIBLE FILE' field",DIR(0)="Y" D ^DIR G PROV:$D(DIRUT)
- I Y=1 S DIU=3.032,DIU(0)="SD" D EN^DIU2
- ;
- PROV ;
- I $D(^DD(6.01,.01,0))[0 G EXIT
- W !!,"The 'MNEMONIC' field in the PROVIDER file has been causing problems.",!,"It is sugested that it be removed."
- S DIR("A")="Remove 'MNEMONIC' field",DIR(0)="Y" D ^DIR G EXIT:$D(DIRUT)
- I Y=1 S DIU=6.01,DIU(0)="SD" D EN^DIU2
- EXIT W !!,"EXIT" K DIR,DIU,Y Q
- A4A7CLUP ;SFISC/RWF - CLEAN UP THE NEW PERSON FILE FOF ;12/27/90 16:25
- +1 ;;1;;
- A IF $GET(DUZ(0))'="@"
- WRITE !!,*7,"You must have VA FileMan Programmer access"
- QUIT
- +1 WRITE !!,"This routine will check and see if your site is using the new File Access",!,"method for VA FileMan. If not it will let you remove the fields in the "
- +2 WRITE !,"New Person and User file that could change the access method by accident"
- N IF $DATA(^DD(200,0))[0
- WRITE !!,"You don't have a New Person file"
- GOTO USER
- +1 IF $DATA(^DD(200.032,0))=0
- GOTO USER
- +2 IF $DATA(^VA(200,"AFOF"))
- WRITE !!,*7,"You have data in your File 200 'AFOF' X-ref. This means that you are using the",!,"'ACCESSIBLE FILE' access."
- GOTO USER
- +3 WRITE !!,"Your NEW PERSON file has the 'ACCESSIBLE FILE' field:"
- +4 SET DIR("A")="Remove 'ACCESSIBLE FILE' field"
- SET DIR(0)="Y"
- DO ^DIR
- IF $DATA(DIRUT)
- GOTO PROV
- +5 IF Y=1
- SET DIU=200.032
- SET DIU(0)="SD"
- DO EN^DIU2
- USER ;
- +1 IF '$DATA(^DIC(3,"AFOF"))
- GOTO U2
- +2 WRITE !!,*7,"You have data in your File 3 'AFOF' X-ref. This means that you are using the",!,"'ACCESSIBLE FILE' access."
- +3 WRITE !,"You must remove this FIRST if you want to run this option."
- GOTO PROV
- U2 ;
- +1 IF $DATA(^DD(3.032,0))=0
- WRITE !,"You don't have the 'ACCESSIBLE FILE' field in your user file."
- GOTO PROV
- +2 WRITE !!,"Your USER file has the 'ACCESSIBLE FILE' field:"
- +3 SET DIR("A")="Remove 'ACCESSIBLE FILE' field"
- SET DIR(0)="Y"
- DO ^DIR
- IF $DATA(DIRUT)
- GOTO PROV
- +4 IF Y=1
- SET DIU=3.032
- SET DIU(0)="SD"
- DO EN^DIU2
- +5 ;
- PROV ;
- +1 IF $DATA(^DD(6.01,.01,0))[0
- GOTO EXIT
- +2 WRITE !!,"The 'MNEMONIC' field in the PROVIDER file has been causing problems.",!,"It is sugested that it be removed."
- +3 SET DIR("A")="Remove 'MNEMONIC' field"
- SET DIR(0)="Y"
- DO ^DIR
- IF $DATA(DIRUT)
- GOTO EXIT
- +4 IF Y=1
- SET DIU=6.01
- SET DIU(0)="SD"
- DO EN^DIU2
- EXIT WRITE !!,"EXIT"
- KILL DIR,DIU,Y
- QUIT
