- SDPARM2 ;ALB/CAW,GXT - Edit Main and Division Parameters; 8/13/2018
- ;;5.3;Scheduling;**27,132,705**;08/13/93;Build 11
- ;;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
- ;
- ;Patch SD*5.3*705 updated this routine to allow the enter/edit
- ;of the ENABLE BLANK LINE? (#1.1), EXCLUDE ADMIN CLINICS? (#1.2),
- ;and ADDITIONAL HEADER TEXT (#1.3) fields in the SCHEDULING PARAMETER
- ;(#404.91) FILE.
- ;The ADDITIONAL HEADER TEXT (#1.3) is a subfile and includes
- ;INSTITUTION, HEADER TEXT and PRINT STARTING AT FIRST LINE? sub fields)
- ;
- 1 ;Edit Main Parameters
- ;
- D FULL^VALM1
- S DIE="^DG(43,",DA=1,DR="212;215;216;32;217;226;227;224T" D ^DIE K DIE
- S DIE="^SD(404.91,",DIC(0)="AEQMZ",DR="1.1;1.2" D ^DIE K DR,DIE,DA ;Patch SD*5.3*705
- I $D(DTOUT) G SDQUIT
- G RDSPLY
- Q
- ;
- 2 ;Edit Division Parameters
- ;
- D FULL^VALM1
- I '$P($G(^DG(43,1,"GL")),U,2) S Y=1 D DIE Q
- DIC W ! S DIC="^DG(40.8,",DIC(0)="AEMQ" D ^DIC I Y<0 S VALMBCK="" G RDSPLY
- DIE S DIE="^DG(40.8,",(SD,DA)=+Y,DR="30.01:30.04" D ^DIE K DIE
- I $D(DTOUT) G SDQUIT
- I $P($G(^DG(43,1,"GL")),U,2) G DIC
- G RDSPLY
- Q
- ;
- 3 ;Edit Additional Header Text Fields in Scheduling Parameter (#404.91) file
- ;
- N DA,DR,DIE
- D FULL^VALM1
- S DA=1 S DR=1.3,DR(2,404.9102)=".01T;1T",DR(3,404.91021)=".01;.02",DIE=404.91 D ^DIE K DR,DA,DIE
- I $D(DTOUT) G SDQUIT
- G RDSPLY
- Q
- ;
- RDSPLY D EN^SDPARM S VALMBCK="R"
- SDQUIT Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPARM2 1407 printed Feb 19, 2025@00:25:55 Page 2
- SDPARM2 ;ALB/CAW,GXT - Edit Main and Division Parameters; 8/13/2018
- +1 ;;5.3;Scheduling;**27,132,705**;08/13/93;Build 11
- +2 ;;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
- +3 ;
- +4 ;Patch SD*5.3*705 updated this routine to allow the enter/edit
- +5 ;of the ENABLE BLANK LINE? (#1.1), EXCLUDE ADMIN CLINICS? (#1.2),
- +6 ;and ADDITIONAL HEADER TEXT (#1.3) fields in the SCHEDULING PARAMETER
- +7 ;(#404.91) FILE.
- +8 ;The ADDITIONAL HEADER TEXT (#1.3) is a subfile and includes
- +9 ;INSTITUTION, HEADER TEXT and PRINT STARTING AT FIRST LINE? sub fields)
- +10 ;
- 1 ;Edit Main Parameters
- +1 ;
- +2 DO FULL^VALM1
- +3 SET DIE="^DG(43,"
- SET DA=1
- SET DR="212;215;216;32;217;226;227;224T"
- DO ^DIE
- KILL DIE
- +4 ;Patch SD*5.3*705
- SET DIE="^SD(404.91,"
- SET DIC(0)="AEQMZ"
- SET DR="1.1;1.2"
- DO ^DIE
- KILL DR,DIE,DA
- +5 IF $DATA(DTOUT)
- GOTO SDQUIT
- +6 GOTO RDSPLY
- +7 QUIT
- +8 ;
- 2 ;Edit Division Parameters
- +1 ;
- +2 DO FULL^VALM1
- +3 IF '$PIECE($GET(^DG(43,1,"GL")),U,2)
- SET Y=1
- DO DIE
- QUIT
- DIC WRITE !
- SET DIC="^DG(40.8,"
- SET DIC(0)="AEMQ"
- DO ^DIC
- IF Y<0
- SET VALMBCK=""
- GOTO RDSPLY
- DIE SET DIE="^DG(40.8,"
- SET (SD,DA)=+Y
- SET DR="30.01:30.04"
- DO ^DIE
- KILL DIE
- +1 IF $DATA(DTOUT)
- GOTO SDQUIT
- +2 IF $PIECE($GET(^DG(43,1,"GL")),U,2)
- GOTO DIC
- +3 GOTO RDSPLY
- +4 QUIT
- +5 ;
- 3 ;Edit Additional Header Text Fields in Scheduling Parameter (#404.91) file
- +1 ;
- +2 NEW DA,DR,DIE
- +3 DO FULL^VALM1
- +4 SET DA=1
- SET DR=1.3
- SET DR(2,404.9102)=".01T;1T"
- SET DR(3,404.91021)=".01;.02"
- SET DIE=404.91
- DO ^DIE
- KILL DR,DA,DIE
- +5 IF $DATA(DTOUT)
- GOTO SDQUIT
- +6 GOTO RDSPLY
- +7 QUIT
- +8 ;
- RDSPLY DO EN^SDPARM
- SET VALMBCK="R"
- SDQUIT QUIT
