source: FOIAVistA/trunk/r/SURGERY-SR/SROESPR2.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1SROESPR2 ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 06/25/02 04:09 PM ]
2 ;;3.0; Surgery ;**100**;24 Jun 93
3 ;
4 ;** NOTICE: This routine is part of an implementation of a nationally
5 ;** controlled procedure. Local modifications to this routine
6 ;** are prohibited.
7 ;
8 ; This routine was cloned in part or in whole from TIUPRPN2.
9FOOTER(SRFOOT,SRFLAG,SRPFNBR,SRHDR,SRCONT1,SRDA) ; Control Pagination
10 ; position, write footer when appropriate
11 ; IF SRHDR=1, HEADER WILL NOT BE PRINTED
12 S SRCONT=1
13 I $E(IOST)="C" G FOOTX:$Y+3<IOSL S SRCONT=$$STOP G FOOTW
14 G FTR:+$G(SRHDR)
15 G:$Y+7<IOSL FOOTX
16FTR I (IOT'="HFS")!(IOSL<250) F Q:$Y+6'<IOSL W ! ;moves ftr to pg bottom
17 N SRFNUM,SRLINE,LOC,DIV,SRDIV,SRDIVI,SRPRTDT,SRPRTNM,SRNOW,SRCASE
18 S $P(SRLINE,"-",81)=""
19 W ?21,$S(+$G(SRCONT1):"** THIS NOTE CONTINUED ON NEXT PAGE **",1:""),!
20 I '+$G(SRFLAG) W "WORK COPY ========== UNOFFICIAL "
21 I W "- NOT FOR MEDICAL RECORD =========== DO NOT FILE"
22 E W SRLINE
23 W !,SRFOOT("PNMP")
24 S SRDIVI="",SRCASE=$P($G(^TMP("SRLQ",$J,SRDA,1405,"I")),";") S:SRCASE DIV=$$SITE^SROUTL0(SRCASE) I DIV S SRDIV=$P(^SRO(133,DIV,0),"^"),SRDIVI=$$EXTERNAL^DILFD(133,.01,"",SRDIV)
25 I SRDIVI="",$G(^TMP("SRLQ",$J,SRDA,1205,"I")) S LOC=+^("I") D
26 .S SRDIV=+$P($G(^SC(LOC,0)),U,4) I SRDIV S SRDIVI=$$GET1^DIQ(4,SRDIV,.01)
27 S SRPRTNM=$S($G(SRDIVI)]"":SRDIVI,$G(SRFOOT("INTNM"))]"":SRFOOT("INTNM"),1:SRFOOT("SITE"))
28 S SRNOW=$$NOW^XLFDT,SRPRTDT="Printed:"_$$DATE^SROESPR(SRNOW,"MM/DD/CCYY HR:MIN")
29 I $L(SRPRTNM)<36 D
30 . W ?(80-$L(SRPRTNM)\2),SRPRTNM,?56,SRPRTDT
31 ELSE D
32 . W ?58,SRPRTDT,!?(80-$L(SRPRTNM)\2),SRPRTNM
33 W !,SRFOOT("SSN")," ",SRFOOT("DOB"),?(80-$L(SRFOOT("LOCP"))\2),SRFOOT("LOCP")
34 I +$G(SRFLAG) W ?(80-$L(SRPFNBR)),SRPFNBR
35 I '+$G(SRFLAG) W ?(80-$L(SRFOOT("PH#"))),SRFOOT("PH#")
36 I +$G(SRFLAG) W !,SRLINE
37 E W !,"=========================== CONFIDENTIAL INFORMATION ==========================="
38 W @IOF
39FOOTW I '+$G(SRHDR),+$G(SRCONT) D HEADER(.SRFOOT,SRFLAG,.SRPFHDR,.SRCONT1)
40FOOTX ;
41 Q SRCONT
42HEADER(SRFOOT,SRFLAG,SRPFHDR,SRCONT1) ; Header
43 N SRLINE S $P(SRLINE,"-",81)="",SROPAGE=+$G(SROPAGE)+1
44 I $E(IOST)="C" D
45 .W @IOF,!,?71,"Page: ",$J(SROPAGE,2)
46 .W !,SRLINE,!,SRFOOT("PNMP")_" "_SRFOOT("SSN")
47 .W ?(78-$L(SRPFHDR)),SRPFHDR,!,SRLINE,!
48 .I +$G(SRCONT1) W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS SCREEN **",!
49 E D
50 .W !?71,"Page: ",$J(SROPAGE,2)
51 .W !,SRLINE,!,$S('+$G(SRFLAG):"** WORK COPY - NOT FOR ",1:"")
52 .W "MEDICAL RECORD" W:'+$G(SRFLAG) " **" W ?(80-$L(SRPFHDR)),SRPFHDR
53 .W !,SRLINE,!
54 .I +$G(SRCONT1) W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS PAGE **",!!
55 K SRCONT1
56 Q
57STOP() ;on screen paging check
58 ; quits SRCONT=1 if cont. ELSE quits SRCONT=0
59 N DIR,Y
60 S DIR(0)="E" D ^DIR
61 S SRCONT=Y
62 Q SRCONT
Note: See TracBrowser for help on using the repository browser.