- PSO7P570 ;AITC/GN-Post install to alter ERX DD'S to Fileman user RD accessible ;8/07/18 10:00am
- ;;7.0;OUTPATIENT PHARMACY;**570**;13 Feb 97;Build 8
- ;
- ; Routine should be deleted after install.
- Q
- EN ; Entry point
- N SEC,ERXFIL,ERR
- D BMES^XPDUTL()
- D MES^XPDUTL("Marking ERX files Fileman Read accessible for Users and Supervisors.")
- D BMES^XPDUTL()
- S SEC("RD")="Pp" ;P = Std user p = Supervisor user
- F ERXFIL=52.45:.01:52.49 K ERR D FILESEC^DDMOD(ERXFIL,.SEC,.ERR) D
- . I '$D(ERR) D BMES^XPDUTL(),MES^XPDUTL($P($G(^DIC(ERXFIL,0)),"^")_" file #"_ERXFIL_" marked.")
- . I $D(ERR) D BMES^XPDUTL(),MES^XPDUTL($P($G(^DIC(ERXFIL,0)),"^")_" file #"_ERXFIL_" NOT marked.")
- D BMES^XPDUTL()
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO7P570 713 printed Feb 18, 2025@23:50:19 Page 2
- PSO7P570 ;AITC/GN-Post install to alter ERX DD'S to Fileman user RD accessible ;8/07/18 10:00am
- +1 ;;7.0;OUTPATIENT PHARMACY;**570**;13 Feb 97;Build 8
- +2 ;
- +3 ; Routine should be deleted after install.
- +4 QUIT
- EN ; Entry point
- +1 NEW SEC,ERXFIL,ERR
- +2 DO BMES^XPDUTL()
- +3 DO MES^XPDUTL("Marking ERX files Fileman Read accessible for Users and Supervisors.")
- +4 DO BMES^XPDUTL()
- +5 ;P = Std user p = Supervisor user
- SET SEC("RD")="Pp"
- +6 FOR ERXFIL=52.45:.01:52.49
- KILL ERR
- DO FILESEC^DDMOD(ERXFIL,.SEC,.ERR)
- Begin DoDot:1
- +7 IF '$DATA(ERR)
- DO BMES^XPDUTL()
- DO MES^XPDUTL($PIECE($GET(^DIC(ERXFIL,0)),"^")_" file #"_ERXFIL_" marked.")
- +8 IF $DATA(ERR)
- DO BMES^XPDUTL()
- DO MES^XPDUTL($PIECE($GET(^DIC(ERXFIL,0)),"^")_" file #"_ERXFIL_" NOT marked.")
- End DoDot:1
- +9 DO BMES^XPDUTL()
- +10 QUIT