| [613] | 1 | PRPFMR3 ;BAYPINES/MJE  VPFS APP PFUNDS FILES CHANGE ATTRIBUTES ;02/22/06
 | 
|---|
 | 2 |         ;;3.0;PATIENT FUNDS - POST MIGRATION 1.0;**17**;JUNE 1, 1989
 | 
|---|
 | 3 |         ;ENTRY AT LINETAG ONLY
 | 
|---|
 | 4 |         Q
 | 
|---|
 | 5 | CHGATRB ; CHANGE THE WRITE AND DELETE ATTRIBUTES FOR PATIENT FUNDS FILES
 | 
|---|
 | 6 |         ;
 | 
|---|
 | 7 |         N SECURITY,FILE,PRPFATRB,FDA,ERRNUM,ERRLIST
 | 
|---|
 | 8 |         ;**** CHANGE GLOBAL FILE ATTRIBS FOR PFUNDS FILES
 | 
|---|
 | 9 |         S SECURITY("LAYGO")="^"
 | 
|---|
 | 10 |         S SECURITY("WR")="^"
 | 
|---|
 | 11 |         S SECURITY("DEL")="^"
 | 
|---|
 | 12 |         F FILE=470,470.1,470.2,470.3,470.5,470.6,470.9 D
 | 
|---|
 | 13 |         . D FILESEC^DDMOD(FILE,.SECURITY)
 | 
|---|
 | 14 |         ;**** CHANGE FILEMAN ATTRIBS FOR PFUNDS FILES PER PFUNDS USER IN AFOF NODE
 | 
|---|
 | 15 |         I $D(^VA(200,"AFOF")) D
 | 
|---|
 | 16 |         . F FILE=470,470.1,470.2,470.3,470.5,470.6,470.9 D
 | 
|---|
 | 17 |         .. N WHO
 | 
|---|
 | 18 |         .. S WHO=0
 | 
|---|
 | 19 |         .. F  S WHO=$O(^VA(200,"AFOF",FILE,WHO)) Q:'WHO  D
 | 
|---|
 | 20 |         ... N IENS
 | 
|---|
 | 21 |         ... S IENS=FILE_","_WHO_","
 | 
|---|
 | 22 |         ... S FDA(200.032,IENS,2)=0
 | 
|---|
 | 23 |         ... S FDA(200.032,IENS,3)=0
 | 
|---|
 | 24 |         ... S FDA(200.032,IENS,5)=0
 | 
|---|
 | 25 |         ... D FILE^DIE("","FDA","PFERR")
 | 
|---|
 | 26 |         ;**** CHANGE DATA DICTIONARY .O1 ATTRIB FOR GLOBAL PFUNDS FILES
 | 
|---|
 | 27 |         F FILE=470,470.1,470.2,470.3,470.5,470.6,470.9 D
 | 
|---|
 | 28 |         . S ^DD(FILE,.01,"DEL",1,0)="D EN^DDIOL(""Deletions are not allowed due to PFOP Migration!!"","""",""!?5,$C(7)"") I 1"
 | 
|---|
 | 29 |         . S ^DD(FILE,.01,"LAYGO",1,0)="D:'$G(XUMF) EN^DDIOL(""Additions are not allowed due to PFOP Migration!!"","""",""!?5,$C(7)"") I +$G(XUMF)"
 | 
|---|
 | 30 |         W !,""
 | 
|---|
 | 31 |         W !," ************ RESULTS FOR CHANGE ATTRIBUTES PFUNDS FILES **************"
 | 
|---|
 | 32 |         S PRPFATRB=0
 | 
|---|
 | 33 |         F FILE=470,470.1,470.2,470.3,470.5,470.6,470.9 D
 | 
|---|
 | 34 |         . S:^DIC(FILE,0,"WR")="^"&(^DIC(FILE,0,"DEL")="^")&(^DIC(FILE,0,"LAYGO")="^") PRPFATRB=PRPFATRB+1
 | 
|---|
 | 35 |         I (+PRPFATRB)=7&('$D(PFERR("DIERR"))) D
 | 
|---|
 | 36 |         . W !," PATIENT FUNDS FILE ACCESS HAS BEEN SUCCESSFULLY UPDATED!"
 | 
|---|
 | 37 |         I (+PRPFATRB)'=7!($D(PFERR("DIERR"))) D
 | 
|---|
 | 38 |         . W !," ERROR: PATIENT FUNDS FILE ACCESS HAS -NOT- BEEN SUCCESSFULLY UPDATED!!"
 | 
|---|
 | 39 |         . I $D(PFERR("DIERR")) D
 | 
|---|
 | 40 |         .. S ERRNUM=$P(PFERR("DIERR"),"^",1)
 | 
|---|
 | 41 |         .. F ERRLIST=1:1:ERRNUM W !,PFERR("DIERR",ERRNUM,"TEXT",1)
 | 
|---|
 | 42 |         W !," **********************************************************************"
 | 
|---|
 | 43 |         W !,""
 | 
|---|
 | 44 |         K PRPFATRB,SECURITY,PRPFATRB,FDA,FILE,ERRNUM,ERRLIST
 | 
|---|