Routine: SDPARM1

SDPARM1 ;ALB/CAW,SBW - Build Display for Division(s) ; 22/8/2018

 ;;5.3;Scheduling;**27,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 the SCHEDULING

 ;PARAMETER (#404.91) file ADDITIONAL HEADER TEXT (#1.3) subfile

 ;data to include INSTITUTION, HEADER TEXT and PRINT STARTING AT

 ;FIRST LINE? sub fields)

CONT ;

 S SDDLN=0

 F SDDIV=0:0 S SDDIV=$O(SDPARM(40.8,SDDIV)) Q:'SDDIV  S SDDLN=SDDLN+1 D DIV S SDDLN(SDDIV)=SDDLN

DIV ;

11 ;

 D SET^SDPARM($$SETSTR^VALM1("Division: "_SDPARM(40.8,SDDIV,.01,"E"),"",1,79))

 D CNTRL^VALM10(SDLN,10,25,IOINHI,IOINORM,0)

12 S X=""

 S X=$$SETSTR^VALM1("Address Loc. on Letters:",X,1,24)

 S X=$$SETSTR^VALM1(SDPARM(40.8,SDDIV,30.01,"E"),X,26,6)

 S X=$$SETSTR^VALM1("OP Lab Test Start Time:",X,37,23)

 S X=$$SETSTR^VALM1($$TIME(SDPARM(40.8,SDDIV,30.02,"E")),X,SDSCOL,5)

 D SET^SDPARM(X)

13 S X=""

 S X=$$SETSTR^VALM1("OP EKG Start Time:",X,42,18)

 S X=$$SETSTR^VALM1($$TIME(SDPARM(40.8,SDDIV,30.03,"E")),X,SDSCOL,5)

 D SET^SDPARM(X)

14 S X=""

 S X=$$SETSTR^VALM1("OP X-ray Start Time:",X,40,20)

 S X=$$SETSTR^VALM1($$TIME(SDPARM(40.8,SDDIV,30.04,"E")),X,SDSCOL,5)

 D SET^SDPARM(X)

 D SET^SDPARM("")

HDRTXT ; Additional Header Text is Displayed if it exist. Added

 ; with patch SD*5.3*705

 ; If there is no additional text display message and quit

 I $D(SDHDR)'>0 D  Q

 . D SET^SDPARM($$SETSTR^VALM1("   *** No Additional Header Text has been entered. ***","",1,79))

 . D CNTRL^VALM10(SDLN,10,25,IOINHI,IOINORM,0)

 ;Display each Institution's additional header text

 N SD1

 S SD1=0

 F  S SD1=$O(SDHDR(SD1)) Q:SD1'>0  D

 . N SD2

 . S SD2=0

 . D SET^SDPARM($$SETSTR^VALM1("Institution/Division: "_SDHDR(SD1),"",1,79))

 . F  S SD2=$O(SDHDR(SD1,SD2)) Q:SD2'>0  D

 . . D SET^SDPARM($$SETSTR^VALM1(" "_$P(SDHDR(SD1,SD2),U,1),"",1,79))

 . . D SET^SDPARM($$SETSTR^VALM1("    Print Starting At First Line?: "_$P(SDHDR(SD1,SD2),U,2),"",1,79))

 . D SET^SDPARM("")

TIME(X) ; -- format time only :=   hr:min

 I X="" Q X

 Q $E(X_"0000",1,2)_":"_$E(X_"0000",3,4)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPARM1   2162     printed  Mar 13, 2025@22:04:30                                                                                                                                                                                                     Page 2

SDPARM1   ;ALB/CAW,SBW - Build Display for Division(s) ; 22/8/2018

 +1       ;;5.3;Scheduling;**27,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 the SCHEDULING

 +5       ;PARAMETER (#404.91) file ADDITIONAL HEADER TEXT (#1.3) subfile

 +6       ;data to include INSTITUTION, HEADER TEXT and PRINT STARTING AT

 +7       ;FIRST LINE? sub fields)

 +8       ;

CONT      ;

 +1        SET SDDLN=0

 +2        FOR SDDIV=0:0

               SET SDDIV=$ORDER(SDPARM(40.8,SDDIV))

               if 'SDDIV

                   QUIT

               SET SDDLN=SDDLN+1

               DO DIV

               SET SDDLN(SDDIV)=SDDLN

 +3        QUIT

 +4       ;

DIV       ;

 +1       ;

11        ;

 +1        DO SET^SDPARM($$SETSTR^VALM1("Division: "_SDPARM(40.8,SDDIV,.01,"E"),"",1,79))

 +2        DO CNTRL^VALM10(SDLN,10,25,IOINHI,IOINORM,0)

 +3       ;

12         SET X=""

 +1        SET X=$$SETSTR^VALM1("Address Loc. on Letters:",X,1,24)

 +2        SET X=$$SETSTR^VALM1(SDPARM(40.8,SDDIV,30.01,"E"),X,26,6)

 +3        SET X=$$SETSTR^VALM1("OP Lab Test Start Time:",X,37,23)

 +4        SET X=$$SETSTR^VALM1($$TIME(SDPARM(40.8,SDDIV,30.02,"E")),X,SDSCOL,5)

 +5        DO SET^SDPARM(X)

 +6       ;

13         SET X=""

 +1        SET X=$$SETSTR^VALM1("OP EKG Start Time:",X,42,18)

 +2        SET X=$$SETSTR^VALM1($$TIME(SDPARM(40.8,SDDIV,30.03,"E")),X,SDSCOL,5)

 +3        DO SET^SDPARM(X)

 +4       ;

14         SET X=""

 +1        SET X=$$SETSTR^VALM1("OP X-ray Start Time:",X,40,20)

 +2        SET X=$$SETSTR^VALM1($$TIME(SDPARM(40.8,SDDIV,30.04,"E")),X,SDSCOL,5)

 +3        DO SET^SDPARM(X)

 +4       ;

 +5        DO SET^SDPARM("")

 +6        QUIT

HDRTXT    ; Additional Header Text is Displayed if it exist. Added

 +1       ; with patch SD*5.3*705

 +2       ; If there is no additional text display message and quit

 +3        IF $DATA(SDHDR)'>0

               Begin DoDot:1

 +4                DO SET^SDPARM($$SETSTR^VALM1("   *** No Additional Header Text has been entered. ***","",1,79))

 +5                DO CNTRL^VALM10(SDLN,10,25,IOINHI,IOINORM,0)

               End DoDot:1

               QUIT

 +6       ;Display each Institution's additional header text

 +7        NEW SD1

 +8        SET SD1=0

 +9        FOR

               SET SD1=$ORDER(SDHDR(SD1))

               if SD1'>0

                   QUIT

               Begin DoDot:1

 +10               NEW SD2

 +11               SET SD2=0

 +12               DO SET^SDPARM($$SETSTR^VALM1("Institution/Division: "_SDHDR(SD1),"",1,79))

 +13               FOR

                       SET SD2=$ORDER(SDHDR(SD1,SD2))

                       if SD2'>0

                           QUIT

                       Begin DoDot:2

 +14                       DO SET^SDPARM($$SETSTR^VALM1(" "_$PIECE(SDHDR(SD1,SD2),U,1),"",1,79))

 +15                       DO SET^SDPARM($$SETSTR^VALM1("    Print Starting At First Line?: "_$PIECE(SDHDR(SD1,SD2),U,2),"",1,79))

                       End DoDot:2

 +16               DO SET^SDPARM("")

               End DoDot:1

 +17       QUIT

TIME(X)   ; -- format time only :=   hr:min

 +1        IF X=""

               QUIT X

 +2        QUIT $EXTRACT(X_"0000",1,2)_":"_$EXTRACT(X_"0000",3,4)

SDPARM1.m