SDPARM ;ALB/CAW,SBW - Build Display for MAS Parameters ; 22/8/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 display and allow the 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)
;
START ;
K XQORS,VALMLEVL D EN^VALM("SD PARM PARAMETERS")
G QUIT
EN ;Entry point for list manager
;
D INIT
;
HDR ;
;
1 D SET(" *** Site Demographics ***")
D CNTRL^VALM10(SDLN,26,26,IOINHI,IOINORM,0)
;
2 S X=""
S X=$$SETSTR^VALM1("Site: ",X,12,6)
S X=$$SETSTR^VALM1(SDSITE,X,18,20)
S X=$$SETSTR^VALM1("Scheduling Version:",X,41,20)
S X=$$SETSTR^VALM1(SDPARM(43,1,205,"E"),X,SDSCOL,4)
D SET(X)
;
3 D SET("")
;
4 D SET(" *** Editable Site Parameters ***")
D CNTRL^VALM10(SDLN,25,32,IOINHI,IOINORM,0)
;
5 S X=""
S X=$$SETSTR^VALM1(" Appt. Search Threshold:",X,1,SDWID)
S X=$$SETSTR^VALM1(SDPARM(43,1,212,"E"),X,SDFCOL,4)
S X=$$SETSTR^VALM1("Appt. Update Mail Group:",X,36,24)
S X=$$SETSTR^VALM1(SDPARM(43,1,215,"E"),X,SDSCOL,19)
D SET(X)
;
6 D SET("")
S X=""
S X=$$SETSTR^VALM1(">>> Dispositioning <<<",X,4,SDWID)
S X=$$SETSTR^VALM1(" NPCDB Mail Group:",X,36,24)
S X=$$SETSTR^VALM1(SDPARM(43,1,216,"E"),X,SDSCOL,19)
D SET(X)
D CNTRL^VALM10(SDLN,4,22,IOINHI,IOINORM,0)
;
7 S X=""
S X=$$SETSTR^VALM1(" Default for View Check Out:",X,1,SDWID)
S X=$$SETSTR^VALM1(SDPARM(43,1,32,"E"),X,SDFCOL,4)
D SET(X)
;
8 S X=""
S X=$$SETSTR^VALM1("Late Activity Mail Group:",X,35,25)
S X=$$SETSTR^VALM1(SDPARM(43,1,217,"E"),X,SDSCOL,19)
D SET(X)
D CNTRL^VALM10(SDLN,4,22,IOINHI,IOINORM,0)
;
9 D SET("")
;
10 S X=""
S X=$$SETSTR^VALM1(" API Messages Mail Group:",X,35,25)
S X=$$SETSTR^VALM1(SDPARM(43,1,226,"E"),X,SDSCOL,19)
D SET(X)
;
11 D SET("")
;
12 S X=""
S X=$$SETSTR^VALM1("Allow '^' out of Class.:",X,6,SDWID)
S X=$$SETSTR^VALM1(SDPARM(43,1,224,"E"),X,SDFCOL,4)
S X=$$SETSTR^VALM1(" API Messages to Process:",X,35,25)
S X=$$SETSTR^VALM1(SDPARM(43,1,227,"E"),X,SDSCOL,19)
D SET(X)
;
13 D SET("")
;
14 S X=""
S X=$$SETSTR^VALM1("Enable Blank Line?:",X,11,SDWID)
S X=$$SETSTR^VALM1(SDPARM(404.91,1,1.1,"E"),X,SDFCOL,4)
S X=$$SETSTR^VALM1("Exclude Admin Clinics:",X,38,24)
S X=$$SETSTR^VALM1(SDPARM(404.91,1,1.2,"E"),X,SDSCOL,19)
D SET(X)
;
15 D SET("")
;
16 D SET(" *** Editable Division Parameters ***")
D CNTRL^VALM10(SDLN,23,36,IOINHI,IOINORM,0)
;
D ^SDPARM1 ; Call to build display for division
;
S VALMCNT=SDLN
;
;
17 D SET(" *** Editable Additional Header Text ***")
D CNTRL^VALM10(SDLN,23,36,IOINHI,IOINORM,0)
;
D HDRTXT^SDPARM1 ; Call to build display for Additional Header Text
;
S VALMCNT=SDLN
Q
;
QUIT ;
K DIC,DIQ,DR,SD,SDJ,SDDIV,SDDLN,SDFCOL,SDSCOL,SDL,SDLN,SDPARM,SDSITE,SDVLAR,SDWID,^TMP("SDPARM",$J)
K SDINST,SDHDR,SDHDRTXT,SDPARM2
Q
INIT ;Init variables
;
K ^TMP("SDPARM",$J)
S SDVLAR="^TMP(""SDPARM"",$J)"
S SDFCOL=31,SDSCOL=61,SDWID=29,SDLN=0
S SDSITE=$P($$SITE^VASITE,U,2) D WAIT^DICD
F DA=0:0 S DA=$O(^DG(40.8,DA)) Q:'DA S DIC="^DG(40.8,",DR=".01;.07;9;30.01:30.04",DIQ="SDPARM",DIQ(0)="E" D EN^DIQ1 W "."
S DIC="^DG(43,",DA=1,DR="32;205;212;215;216;217;224;226;227",DIQ="SDPARM",DIQ(0)="E" D EN^DIQ1
;Retrieve new Scheduling Parameters in File 404.91 added with patch SD*5.3*705
S DIC="^SD(404.91,",DA=1,DR="1.1;1.2;1.3",DIQ="SDPARM",DIQ(0)="E" D EN^DIQ1
F SDINST=0:0 S SDINST=$O(^SD(404.91,DA,2,SDINST)) Q:'SDINST D
. ;N SDPARM2
. S DR(404.9102)=".01;1",DA(404.9102)=SDINST,DIQ="SDPARM2",DIQ(0)="E" D EN^DIQ1
. S SDHDR(SDINST)=SDPARM2(404.9102,SDINST,.01,"E")
. ;S DR="1.3",DR(404.9102)=".01;1",DA(404.9102)=SDINST,DIQ="SDPARM2",DIQ(0)="E" D EN^DIQ1
. F SDHDRTXT=0:0 S SDHDRTXT=$O(^SD(404.91,DA,2,SDINST,1,SDHDRTXT)) Q:'SDHDRTXT D
. . S DR(404.91021)=".01;.02",DA(404.91021)=SDHDRTXT,DIQ="SDPARM2",DIQ(0)="E" D EN^DIQ1
. . S SDHDR(SDINST,SDHDRTXT)=SDPARM2(404.91021,SDHDRTXT,.01,"E")_U_SDPARM2(404.91021,SDHDRTXT,.02,"E")
Q
SET(X) ; Set in ^TMP global for display
;
S SDLN=SDLN+1,^TMP("SDPARM",$J,SDLN,0)=X
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPARM 4496 printed Dec 13, 2024@02:59:23 Page 2
SDPARM ;ALB/CAW,SBW - Build Display for MAS Parameters ; 22/8/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 display and allow the 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 ;
START ;
+1 KILL XQORS,VALMLEVL
DO EN^VALM("SD PARM PARAMETERS")
+2 GOTO QUIT
EN ;Entry point for list manager
+1 ;
+2 DO INIT
+3 ;
HDR ;
+1 ;
1 DO SET(" *** Site Demographics ***")
+1 DO CNTRL^VALM10(SDLN,26,26,IOINHI,IOINORM,0)
+2 ;
2 SET X=""
+1 SET X=$$SETSTR^VALM1("Site: ",X,12,6)
+2 SET X=$$SETSTR^VALM1(SDSITE,X,18,20)
+3 SET X=$$SETSTR^VALM1("Scheduling Version:",X,41,20)
+4 SET X=$$SETSTR^VALM1(SDPARM(43,1,205,"E"),X,SDSCOL,4)
+5 DO SET(X)
+6 ;
3 DO SET("")
+1 ;
4 DO SET(" *** Editable Site Parameters ***")
+1 DO CNTRL^VALM10(SDLN,25,32,IOINHI,IOINORM,0)
+2 ;
5 SET X=""
+1 SET X=$$SETSTR^VALM1(" Appt. Search Threshold:",X,1,SDWID)
+2 SET X=$$SETSTR^VALM1(SDPARM(43,1,212,"E"),X,SDFCOL,4)
+3 SET X=$$SETSTR^VALM1("Appt. Update Mail Group:",X,36,24)
+4 SET X=$$SETSTR^VALM1(SDPARM(43,1,215,"E"),X,SDSCOL,19)
+5 DO SET(X)
+6 ;
6 DO SET("")
+1 SET X=""
+2 SET X=$$SETSTR^VALM1(">>> Dispositioning <<<",X,4,SDWID)
+3 SET X=$$SETSTR^VALM1(" NPCDB Mail Group:",X,36,24)
+4 SET X=$$SETSTR^VALM1(SDPARM(43,1,216,"E"),X,SDSCOL,19)
+5 DO SET(X)
+6 DO CNTRL^VALM10(SDLN,4,22,IOINHI,IOINORM,0)
+7 ;
7 SET X=""
+1 SET X=$$SETSTR^VALM1(" Default for View Check Out:",X,1,SDWID)
+2 SET X=$$SETSTR^VALM1(SDPARM(43,1,32,"E"),X,SDFCOL,4)
+3 DO SET(X)
+4 ;
8 SET X=""
+1 SET X=$$SETSTR^VALM1("Late Activity Mail Group:",X,35,25)
+2 SET X=$$SETSTR^VALM1(SDPARM(43,1,217,"E"),X,SDSCOL,19)
+3 DO SET(X)
+4 DO CNTRL^VALM10(SDLN,4,22,IOINHI,IOINORM,0)
+5 ;
9 DO SET("")
+1 ;
10 SET X=""
+1 SET X=$$SETSTR^VALM1(" API Messages Mail Group:",X,35,25)
+2 SET X=$$SETSTR^VALM1(SDPARM(43,1,226,"E"),X,SDSCOL,19)
+3 DO SET(X)
+4 ;
11 DO SET("")
+1 ;
12 SET X=""
+1 SET X=$$SETSTR^VALM1("Allow '^' out of Class.:",X,6,SDWID)
+2 SET X=$$SETSTR^VALM1(SDPARM(43,1,224,"E"),X,SDFCOL,4)
+3 SET X=$$SETSTR^VALM1(" API Messages to Process:",X,35,25)
+4 SET X=$$SETSTR^VALM1(SDPARM(43,1,227,"E"),X,SDSCOL,19)
+5 DO SET(X)
+6 ;
13 DO SET("")
+1 ;
14 SET X=""
+1 SET X=$$SETSTR^VALM1("Enable Blank Line?:",X,11,SDWID)
+2 SET X=$$SETSTR^VALM1(SDPARM(404.91,1,1.1,"E"),X,SDFCOL,4)
+3 SET X=$$SETSTR^VALM1("Exclude Admin Clinics:",X,38,24)
+4 SET X=$$SETSTR^VALM1(SDPARM(404.91,1,1.2,"E"),X,SDSCOL,19)
+5 DO SET(X)
+6 ;
15 DO SET("")
+1 ;
16 DO SET(" *** Editable Division Parameters ***")
+1 DO CNTRL^VALM10(SDLN,23,36,IOINHI,IOINORM,0)
+2 ;
+3 ; Call to build display for division
DO ^SDPARM1
+4 ;
+5 SET VALMCNT=SDLN
+6 ;
+7 ;
17 DO SET(" *** Editable Additional Header Text ***")
+1 DO CNTRL^VALM10(SDLN,23,36,IOINHI,IOINORM,0)
+2 ;
+3 ; Call to build display for Additional Header Text
DO HDRTXT^SDPARM1
+4 ;
+5 SET VALMCNT=SDLN
+6 QUIT
+7 ;
QUIT ;
+1 KILL DIC,DIQ,DR,SD,SDJ,SDDIV,SDDLN,SDFCOL,SDSCOL,SDL,SDLN,SDPARM,SDSITE,SDVLAR,SDWID,^TMP("SDPARM",$JOB)
+2 KILL SDINST,SDHDR,SDHDRTXT,SDPARM2
+3 QUIT
INIT ;Init variables
+1 ;
+2 KILL ^TMP("SDPARM",$JOB)
+3 SET SDVLAR="^TMP(""SDPARM"",$J)"
+4 SET SDFCOL=31
SET SDSCOL=61
SET SDWID=29
SET SDLN=0
+5 SET SDSITE=$PIECE($$SITE^VASITE,U,2)
DO WAIT^DICD
+6 FOR DA=0:0
SET DA=$ORDER(^DG(40.8,DA))
if 'DA
QUIT
SET DIC="^DG(40.8,"
SET DR=".01;.07;9;30.01:30.04"
SET DIQ="SDPARM"
SET DIQ(0)="E"
DO EN^DIQ1
WRITE "."
+7 SET DIC="^DG(43,"
SET DA=1
SET DR="32;205;212;215;216;217;224;226;227"
SET DIQ="SDPARM"
SET DIQ(0)="E"
DO EN^DIQ1
+8 ;Retrieve new Scheduling Parameters in File 404.91 added with patch SD*5.3*705
+9 SET DIC="^SD(404.91,"
SET DA=1
SET DR="1.1;1.2;1.3"
SET DIQ="SDPARM"
SET DIQ(0)="E"
DO EN^DIQ1
+10 FOR SDINST=0:0
SET SDINST=$ORDER(^SD(404.91,DA,2,SDINST))
if 'SDINST
QUIT
Begin DoDot:1
+11 ;N SDPARM2
+12 SET DR(404.9102)=".01;1"
SET DA(404.9102)=SDINST
SET DIQ="SDPARM2"
SET DIQ(0)="E"
DO EN^DIQ1
+13 SET SDHDR(SDINST)=SDPARM2(404.9102,SDINST,.01,"E")
+14 ;S DR="1.3",DR(404.9102)=".01;1",DA(404.9102)=SDINST,DIQ="SDPARM2",DIQ(0)="E" D EN^DIQ1
+15 FOR SDHDRTXT=0:0
SET SDHDRTXT=$ORDER(^SD(404.91,DA,2,SDINST,1,SDHDRTXT))
if 'SDHDRTXT
QUIT
Begin DoDot:2
+16 SET DR(404.91021)=".01;.02"
SET DA(404.91021)=SDHDRTXT
SET DIQ="SDPARM2"
SET DIQ(0)="E"
DO EN^DIQ1
+17 SET SDHDR(SDINST,SDHDRTXT)=SDPARM2(404.91021,SDHDRTXT,.01,"E")_U_SDPARM2(404.91021,SDHDRTXT,.02,"E")
End DoDot:2
End DoDot:1
+18 QUIT
SET(X) ; Set in ^TMP global for display
+1 ;
+2 SET SDLN=SDLN+1
SET ^TMP("SDPARM",$JOB,SDLN,0)=X
+3 QUIT
+4 ;
