PRPFMR3 ;BAYPINES/MJE VPFS APP PFUNDS FILES CHANGE ATTRIBUTES ;02/22/06
;;3.0;PATIENT FUNDS - POST MIGRATION 1.0;**17**;JUNE 1, 1989
;ENTRY AT LINETAG ONLY
Q
CHGATRB ; CHANGE THE WRITE AND DELETE ATTRIBUTES FOR PATIENT FUNDS FILES
;
N SECURITY,FILE,PRPFATRB,FDA,ERRNUM,ERRLIST
;**** CHANGE GLOBAL FILE ATTRIBS FOR PFUNDS FILES
S SECURITY("LAYGO")="^"
S SECURITY("WR")="^"
S SECURITY("DEL")="^"
F FILE=470,470.1,470.2,470.3,470.5,470.6,470.9 D
. D FILESEC^DDMOD(FILE,.SECURITY)
;**** CHANGE FILEMAN ATTRIBS FOR PFUNDS FILES PER PFUNDS USER IN AFOF NODE
I $D(^VA(200,"AFOF")) D
. F FILE=470,470.1,470.2,470.3,470.5,470.6,470.9 D
.. N WHO
.. S WHO=0
.. F S WHO=$O(^VA(200,"AFOF",FILE,WHO)) Q:'WHO D
... N IENS
... S IENS=FILE_","_WHO_","
... S FDA(200.032,IENS,2)=0
... S FDA(200.032,IENS,3)=0
... S FDA(200.032,IENS,5)=0
... D FILE^DIE("","FDA","PFERR")
;**** CHANGE DATA DICTIONARY .O1 ATTRIB FOR GLOBAL PFUNDS FILES
F FILE=470,470.1,470.2,470.3,470.5,470.6,470.9 D
. S ^DD(FILE,.01,"DEL",1,0)="D EN^DDIOL(""Deletions are not allowed due to PFOP Migration!!"","""",""!?5,$C(7)"") I 1"
. 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)"
W !,""
W !," ************ RESULTS FOR CHANGE ATTRIBUTES PFUNDS FILES **************"
S PRPFATRB=0
F FILE=470,470.1,470.2,470.3,470.5,470.6,470.9 D
. S:^DIC(FILE,0,"WR")="^"&(^DIC(FILE,0,"DEL")="^")&(^DIC(FILE,0,"LAYGO")="^") PRPFATRB=PRPFATRB+1
I (+PRPFATRB)=7&('$D(PFERR("DIERR"))) D
. W !," PATIENT FUNDS FILE ACCESS HAS BEEN SUCCESSFULLY UPDATED!"
I (+PRPFATRB)'=7!($D(PFERR("DIERR"))) D
. W !," ERROR: PATIENT FUNDS FILE ACCESS HAS -NOT- BEEN SUCCESSFULLY UPDATED!!"
. I $D(PFERR("DIERR")) D
.. S ERRNUM=$P(PFERR("DIERR"),"^",1)
.. F ERRLIST=1:1:ERRNUM W !,PFERR("DIERR",ERRNUM,"TEXT",1)
W !," **********************************************************************"
W !,""
K PRPFATRB,SECURITY,PRPFATRB,FDA,FILE,ERRNUM,ERRLIST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFMR3 2042 printed Apr 09, 2024@21:04:44 Page 2
PRPFMR3 ;BAYPINES/MJE VPFS APP PFUNDS FILES CHANGE ATTRIBUTES ;02/22/06
+1 ;;3.0;PATIENT FUNDS - POST MIGRATION 1.0;**17**;JUNE 1, 1989
+2 ;ENTRY AT LINETAG ONLY
+3 QUIT
CHGATRB ; CHANGE THE WRITE AND DELETE ATTRIBUTES FOR PATIENT FUNDS FILES
+1 ;
+2 NEW SECURITY,FILE,PRPFATRB,FDA,ERRNUM,ERRLIST
+3 ;**** CHANGE GLOBAL FILE ATTRIBS FOR PFUNDS FILES
+4 SET SECURITY("LAYGO")="^"
+5 SET SECURITY("WR")="^"
+6 SET SECURITY("DEL")="^"
+7 FOR FILE=470,470.1,470.2,470.3,470.5,470.6,470.9
Begin DoDot:1
+8 DO FILESEC^DDMOD(FILE,.SECURITY)
End DoDot:1
+9 ;**** CHANGE FILEMAN ATTRIBS FOR PFUNDS FILES PER PFUNDS USER IN AFOF NODE
+10 IF $DATA(^VA(200,"AFOF"))
Begin DoDot:1
+11 FOR FILE=470,470.1,470.2,470.3,470.5,470.6,470.9
Begin DoDot:2
+12 NEW WHO
+13 SET WHO=0
+14 FOR
SET WHO=$ORDER(^VA(200,"AFOF",FILE,WHO))
if 'WHO
QUIT
Begin DoDot:3
+15 NEW IENS
+16 SET IENS=FILE_","_WHO_","
+17 SET FDA(200.032,IENS,2)=0
+18 SET FDA(200.032,IENS,3)=0
+19 SET FDA(200.032,IENS,5)=0
+20 DO FILE^DIE("","FDA","PFERR")
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;**** CHANGE DATA DICTIONARY .O1 ATTRIB FOR GLOBAL PFUNDS FILES
+22 FOR FILE=470,470.1,470.2,470.3,470.5,470.6,470.9
Begin DoDot:1
+23 SET ^DD(FILE,.01,"DEL",1,0)="D EN^DDIOL(""Deletions are not allowed due to PFOP Migration!!"","""",""!?5,$C(7)"") I 1"
+24 SET ^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)"
End DoDot:1
+25 WRITE !,""
+26 WRITE !," ************ RESULTS FOR CHANGE ATTRIBUTES PFUNDS FILES **************"
+27 SET PRPFATRB=0
+28 FOR FILE=470,470.1,470.2,470.3,470.5,470.6,470.9
Begin DoDot:1
+29 if ^DIC(FILE,0,"WR")="^"&(^DIC(FILE,0,"DEL")="^")&(^DIC(FILE,0,"LAYGO")="^")
SET PRPFATRB=PRPFATRB+1
End DoDot:1
+30 IF (+PRPFATRB)=7&('$DATA(PFERR("DIERR")))
Begin DoDot:1
+31 WRITE !," PATIENT FUNDS FILE ACCESS HAS BEEN SUCCESSFULLY UPDATED!"
End DoDot:1
+32 IF (+PRPFATRB)'=7!($DATA(PFERR("DIERR")))
Begin DoDot:1
+33 WRITE !," ERROR: PATIENT FUNDS FILE ACCESS HAS -NOT- BEEN SUCCESSFULLY UPDATED!!"
+34 IF $DATA(PFERR("DIERR"))
Begin DoDot:2
+35 SET ERRNUM=$PIECE(PFERR("DIERR"),"^",1)
+36 FOR ERRLIST=1:1:ERRNUM
WRITE !,PFERR("DIERR",ERRNUM,"TEXT",1)
End DoDot:2
End DoDot:1
+37 WRITE !," **********************************************************************"
+38 WRITE !,""
+39 KILL PRPFATRB,SECURITY,PRPFATRB,FDA,FILE,ERRNUM,ERRLIST
