Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: YSFORM

YSFORM.m

Go to the documentation of this file.
  1. YSFORM ;SLC/TGA-HEADER & FOOTER FOR FORMS ;3/27/90 15:01 ;
  1. ;;5.01;MENTAL HEALTH;**187**;Dec 30, 1994;Build 73
  1. ;
  1. ENHD ; Called by routines YSDX3R, YSDX3R1, YSDX3RU, YSDSR, YSHX1R YSPDR1
  1. ; YSPDXR, YSPHYR, YSPP, YSPP1, YSPP1A, YSPP3, YSPP4, YSPP5, YSPP6
  1. ; YSPP7, YSPP8, YSPP9, YSPRBR1, YSPRBR2, YSPROB5, YSPROBR, YSPROSE
  1. ; YSPTXR
  1. ;Generates page header
  1. S:'$D(YSCON) YSCON=0 S:'$D(YSFTR) YSFTR="" S:'$D(YSFHDR(1)) YSFHDR(1)="" W @IOF
  1. S:'$D(YSLCN) YSLCN=$$SITE,YSLCN="VAMC "_YSLCN
  1. I IOST?1"C-".E W YSNM,?47,"SSN ",$$MASKSSN(YSSSN),?65,"DOB ",YSDOB,!
  1. I IOST?1"P".E W ! F I0=1:1:80 W "-"
  1. I IOST?1"P".E W ! W:YSFTR]"" "MEDICAL RECORD"
  1. W ?80-$L(YSFHDR)/2,YSFHDR I IOST?1"P".E W ! F I0=1:1:IOM W "-"
  1. W:YSCON !?25,"(Continued from previous page)" X:YSFHDR(1)]"" YSFHDR(1)
  1. K I0 S YSCON=0 Q
  1. ;
  1. ENFT ; Called by routines YSDX3R1, YSDX3RU, YSDXR, YSHX1R YSPDR1
  1. ; YSPDXR, YSPHYR, YSPP, YSPP1, YSPP1A, YSPP3, YSPP4, YSPP5
  1. ; YSPP7, YSPP8, YSPP9, YSPRBR1, YSPRBR2, YSPROB5, YSPROBR1, YSPROSE
  1. ; YSPTXR
  1. ;Generates page footer
  1. S:'$D(YSFTR) YSFTR="" S:'$D(YSCON) YSCON=0
  1. S:'$D(YSLCN) YSLCN=$$SITE,YSLCN="VAMC "_YSLCN
  1. F I0=1:1:(IOSL-$Y-9) W !
  1. W ! W:YSCON ?28,"(Continued on next page)"
  1. W ! F I0=1:1:IOM W "_"
  1. W !,YSNM,?(31+(37-$L(YSLCN)/2)),YSLCN W:YSFTR]"" ?69,"VAF 10-9034"
  1. I YSFTR]"" S YSFTR(1)="(VICE "_YSFTR_")"
  1. W !,$$MASKSSN(YSSSN) W:YSDOB]"" " DOB ",YSDOB W:YSFTR]"" ?(80-$L(YSFTR(1))),YSFTR(1)
  1. W:IOST?1"P".E ! K I0 Q
  1. ;
  1. SITE() ;Set YSLOC to location using KERNEL site parameter file entry
  1. N DIC,DA,DIQ,DR
  1. S YSDA=+$P(^XMB(1,1,"XUS"),U,17)
  1. S DIC=4,DR=".01",DA=YSDA,DIQ(0)="EN",DIQ="YSLOC" D EN^DIQ1
  1. S YSLOC=$P(YSLOC(4,+YSDA,.01,"E"),",")
  1. QUIT YSLOC
  1. ;
  1. MASKSSN(YSSSN) ; return only last 4 of SSN
  1. Q "xxx-xx-"_$E(YSSSN,$L(YSSSN)-3,$L(YSSSN))