YSFORM ;SLC/TGA-HEADER & FOOTER FOR FORMS ;3/27/90 15:01 ;
;;5.01;MENTAL HEALTH;**187**;Dec 30, 1994;Build 73
;
ENHD ; Called by routines YSDX3R, YSDX3R1, YSDX3RU, YSDSR, YSHX1R YSPDR1
; YSPDXR, YSPHYR, YSPP, YSPP1, YSPP1A, YSPP3, YSPP4, YSPP5, YSPP6
; YSPP7, YSPP8, YSPP9, YSPRBR1, YSPRBR2, YSPROB5, YSPROBR, YSPROSE
; YSPTXR
;Generates page header
S:'$D(YSCON) YSCON=0 S:'$D(YSFTR) YSFTR="" S:'$D(YSFHDR(1)) YSFHDR(1)="" W @IOF
S:'$D(YSLCN) YSLCN=$$SITE,YSLCN="VAMC "_YSLCN
I IOST?1"C-".E W YSNM,?47,"SSN ",$$MASKSSN(YSSSN),?65,"DOB ",YSDOB,!
I IOST?1"P".E W ! F I0=1:1:80 W "-"
I IOST?1"P".E W ! W:YSFTR]"" "MEDICAL RECORD"
W ?80-$L(YSFHDR)/2,YSFHDR I IOST?1"P".E W ! F I0=1:1:IOM W "-"
W:YSCON !?25,"(Continued from previous page)" X:YSFHDR(1)]"" YSFHDR(1)
K I0 S YSCON=0 Q
;
ENFT ; Called by routines YSDX3R1, YSDX3RU, YSDXR, YSHX1R YSPDR1
; YSPDXR, YSPHYR, YSPP, YSPP1, YSPP1A, YSPP3, YSPP4, YSPP5
; YSPP7, YSPP8, YSPP9, YSPRBR1, YSPRBR2, YSPROB5, YSPROBR1, YSPROSE
; YSPTXR
;Generates page footer
S:'$D(YSFTR) YSFTR="" S:'$D(YSCON) YSCON=0
S:'$D(YSLCN) YSLCN=$$SITE,YSLCN="VAMC "_YSLCN
F I0=1:1:(IOSL-$Y-9) W !
W ! W:YSCON ?28,"(Continued on next page)"
W ! F I0=1:1:IOM W "_"
W !,YSNM,?(31+(37-$L(YSLCN)/2)),YSLCN W:YSFTR]"" ?69,"VAF 10-9034"
I YSFTR]"" S YSFTR(1)="(VICE "_YSFTR_")"
W !,$$MASKSSN(YSSSN) W:YSDOB]"" " DOB ",YSDOB W:YSFTR]"" ?(80-$L(YSFTR(1))),YSFTR(1)
W:IOST?1"P".E ! K I0 Q
;
SITE() ;Set YSLOC to location using KERNEL site parameter file entry
N DIC,DA,DIQ,DR
S YSDA=+$P(^XMB(1,1,"XUS"),U,17)
S DIC=4,DR=".01",DA=YSDA,DIQ(0)="EN",DIQ="YSLOC" D EN^DIQ1
S YSLOC=$P(YSLOC(4,+YSDA,.01,"E"),",")
QUIT YSLOC
;
MASKSSN(YSSSN) ; return only last 4 of SSN
Q "xxx-xx-"_$E(YSSSN,$L(YSSSN)-3,$L(YSSSN))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSFORM 1807 printed Apr 09, 2024@21:16:12 Page 2
YSFORM ;SLC/TGA-HEADER & FOOTER FOR FORMS ;3/27/90 15:01 ;
+1 ;;5.01;MENTAL HEALTH;**187**;Dec 30, 1994;Build 73
+2 ;
ENHD ; Called by routines YSDX3R, YSDX3R1, YSDX3RU, YSDSR, YSHX1R YSPDR1
+1 ; YSPDXR, YSPHYR, YSPP, YSPP1, YSPP1A, YSPP3, YSPP4, YSPP5, YSPP6
+2 ; YSPP7, YSPP8, YSPP9, YSPRBR1, YSPRBR2, YSPROB5, YSPROBR, YSPROSE
+3 ; YSPTXR
+4 ;Generates page header
+5 if '$DATA(YSCON)
SET YSCON=0
if '$DATA(YSFTR)
SET YSFTR=""
if '$DATA(YSFHDR(1))
SET YSFHDR(1)=""
WRITE @IOF
+6 if '$DATA(YSLCN)
SET YSLCN=$$SITE
SET YSLCN="VAMC "_YSLCN
+7 IF IOST?1"C-".E
WRITE YSNM,?47,"SSN ",$$MASKSSN(YSSSN),?65,"DOB ",YSDOB,!
+8 IF IOST?1"P".E
WRITE !
FOR I0=1:1:80
WRITE "-"
+9 IF IOST?1"P".E
WRITE !
if YSFTR]""
WRITE "MEDICAL RECORD"
+10 WRITE ?80-$LENGTH(YSFHDR)/2,YSFHDR
IF IOST?1"P".E
WRITE !
FOR I0=1:1:IOM
WRITE "-"
+11 if YSCON
WRITE !?25,"(Continued from previous page)"
if YSFHDR(1)]""
XECUTE YSFHDR(1)
+12 KILL I0
SET YSCON=0
QUIT
+13 ;
ENFT ; Called by routines YSDX3R1, YSDX3RU, YSDXR, YSHX1R YSPDR1
+1 ; YSPDXR, YSPHYR, YSPP, YSPP1, YSPP1A, YSPP3, YSPP4, YSPP5
+2 ; YSPP7, YSPP8, YSPP9, YSPRBR1, YSPRBR2, YSPROB5, YSPROBR1, YSPROSE
+3 ; YSPTXR
+4 ;Generates page footer
+5 if '$DATA(YSFTR)
SET YSFTR=""
if '$DATA(YSCON)
SET YSCON=0
+6 if '$DATA(YSLCN)
SET YSLCN=$$SITE
SET YSLCN="VAMC "_YSLCN
+7 FOR I0=1:1:(IOSL-$Y-9)
WRITE !
+8 WRITE !
if YSCON
WRITE ?28,"(Continued on next page)"
+9 WRITE !
FOR I0=1:1:IOM
WRITE "_"
+10 WRITE !,YSNM,?(31+(37-$LENGTH(YSLCN)/2)),YSLCN
if YSFTR]""
WRITE ?69,"VAF 10-9034"
+11 IF YSFTR]""
SET YSFTR(1)="(VICE "_YSFTR_")"
+12 WRITE !,$$MASKSSN(YSSSN)
if YSDOB]""
WRITE " DOB ",YSDOB
if YSFTR]""
WRITE ?(80-$LENGTH(YSFTR(1))),YSFTR(1)
+13 if IOST?1"P".E
WRITE !
KILL I0
QUIT
+14 ;
SITE() ;Set YSLOC to location using KERNEL site parameter file entry
+1 NEW DIC,DA,DIQ,DR
+2 SET YSDA=+$PIECE(^XMB(1,1,"XUS"),U,17)
+3 SET DIC=4
SET DR=".01"
SET DA=YSDA
SET DIQ(0)="EN"
SET DIQ="YSLOC"
DO EN^DIQ1
+4 SET YSLOC=$PIECE(YSLOC(4,+YSDA,.01,"E"),",")
+5 QUIT YSLOC
+6 ;
MASKSSN(YSSSN) ; return only last 4 of SSN
+1 QUIT "xxx-xx-"_$EXTRACT(YSSSN,$LENGTH(YSSSN)-3,$LENGTH(YSSSN))
