source: WorldVistAEHR/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFMR3.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1PRPFMR3 ;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
5CHGATRB ; 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
Note: See TracBrowser for help on using the repository browser.