TIUPRPN2 ;SLC/MJC - Header/Footer for Progress Notes ;25-JAN-2001 08:50:35
;;1.0;TEXT INTEGRATION UTILITIES;**44,45,52,100,222**;Jun 20, 1997
; Also controls Pagination position, writes footer when appropriate.
; Requires array TIUFOOT, vars TIUMISC,TIUCONT1. Optional TIUHDR.
; IF TIUHDR=1, HEADER WILL NOT BE PRINTED
N TIUCONT,TIUFLAG,TIUPFNBR,TIUDA
S TIUCONT=1
S TIUFLAG=$P(TIUMISC,U),TIUPFNBR=$P(TIUMISC,U,2),TIUDA=$P(TIUMISC,U,3)
I $E(IOST)="C" G FOOTX:$Y+3<IOSL S TIUCONT=$$STOP G FOOTW
G FTR:+$G(TIUHDR)
G:$Y+7<IOSL FOOTX
FTR I (IOT'="HFS")!(IOSL<250) F Q:$Y+6'<IOSL W ! ;moves ftr to pg bottom
N TIUFNUM,TIULINE,LOC,DIV,TIUDIV,TIUDIVI,TIUPRTDT,TIUPRTNM
S $P(TIULINE,"-",81)=""
W ?21,$S(+$G(TIUCONT1):"** THIS NOTE CONTINUED ON NEXT PAGE **",1:""),!
I '+$G(TIUFLAG) W "WORK COPY ========== UNOFFICIAL "
I W "- NOT FOR MEDICAL RECORD =========== DO NOT FILE"
E W TIULINE
W !,TIUFOOT("PNMP")
S LOC=$S($L(TIUROOT):$G(@TIUROOT@(1205,"I")),1:"") ; **100**
I LOC D
. S DIV=+$P($G(^SC(LOC,0)),U,15)
. S TIUDIV=+$O(^TIU(8925.94,"B",DIV,0))
I $G(TIUDIV),$P($G(^TIU(8925.94,TIUDIV,0)),U,2)]"" S TIUDIVI=$P(^(0),U,2)
S TIUPRTNM=$S($G(TIUDIVI)]"":TIUDIVI,$G(TIUFOOT("INTNM"))]"":TIUFOOT("INTNM"),1:TIUFOOT("SITE"))
S TIUPRTDT="Printed:"_$$DATE^TIULS($$NOW^TIULC,"MM/DD/CCYY HR:MIN")
I $L(TIUPRTNM)<36 D
. W ?(80-$L(TIUPRTNM)\2),TIUPRTNM,?56,TIUPRTDT
ELSE D
. W ?58,TIUPRTDT,!?(80-$L(TIUPRTNM)\2),TIUPRTNM
I +$G(TIUFLAG) W !,TIUFOOT("SSN")," ",TIUFOOT("DOB"),?(80-$L(TIUFOOT("LOCP"))\2),TIUFOOT("LOCP") ; *222 only print if NOT WORKCOPY
I '+$G(TIUFLAG) W !,?(80-$L(TIUFOOT("LOCP"))\2),TIUFOOT("LOCP")
I +$G(TIUFLAG) W ?(80-$L(TIUPFNBR)),TIUPFNBR
I '+$G(TIUFLAG) W ?(80-$L(TIUFOOT("PH#"))),TIUFOOT("PH#")
I +$G(TIUFLAG) W !,TIULINE
E W !,"=========================== CONFIDENTIAL INFORMATION ==========================="
W @IOF
Q TIUCONT
; Requires array TIUFOOT, vars TIUFLAG,TIUPFHDR,TIUCONT1
N TIULINE S $P(TIULINE,"-",81)=""
I $E(IOST)="C" D
.W @IOF,$C(13),TIULINE,!,TIUFOOT("PNMP")_" "_TIUFOOT("SSN")
.W ?(78-$L(TIUPFHDR)),TIUPFHDR,!,TIULINE,!
.I +$G(TIUCONT1) W $$DATE^TIULS(@TIUROOT@(1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS SCREEN **",!
E D
.W !,TIULINE,!,$S('+$G(TIUFLAG):"** WORK COPY - NOT FOR ",1:"")
.W "MEDICAL RECORD" W:'+$G(TIUFLAG) " **" W ?(80-$L(TIUPFHDR)),TIUPFHDR
.W !,TIULINE,!
.I +$G(TIUCONT1) W $$DATE^TIULS(@TIUROOT@(1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS PAGE **",!!
Q
STOP() ;on screen paging check
; quits TIUCONT=1 if cont. ELSE quits TIUCONT=0
N DIR,Y,TIUCONT
S DIR(0)="E" W:+$G(TIUKID) ! D ^DIR
S TIUCONT=Y
Q TIUCONT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPRPN2 2942 printed Nov 22, 2024@17:53:43 Page 2
TIUPRPN2 ;SLC/MJC - Header/Footer for Progress Notes ;25-JAN-2001 08:50:35
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**44,45,52,100,222**;Jun 20, 1997
+1 ; Also controls Pagination position, writes footer when appropriate.
+2 ; Requires array TIUFOOT, vars TIUMISC,TIUCONT1. Optional TIUHDR.
+3 ; IF TIUHDR=1, HEADER WILL NOT BE PRINTED
+4 NEW TIUCONT,TIUFLAG,TIUPFNBR,TIUDA
+5 SET TIUCONT=1
+6 SET TIUFLAG=$PIECE(TIUMISC,U)
SET TIUPFNBR=$PIECE(TIUMISC,U,2)
SET TIUDA=$PIECE(TIUMISC,U,3)
+7 IF $EXTRACT(IOST)="C"
if $Y+3<IOSL
GOTO FOOTX
SET TIUCONT=$$STOP
GOTO FOOTW
+8 if +$GET(TIUHDR)
GOTO FTR
+9 if $Y+7<IOSL
GOTO FOOTX
FTR ;moves ftr to pg bottom
IF (IOT'="HFS")!(IOSL<250)
FOR
if $Y+6'<IOSL
QUIT
WRITE !
+1 NEW TIUFNUM,TIULINE,LOC,DIV,TIUDIV,TIUDIVI,TIUPRTDT,TIUPRTNM
+2 SET $PIECE(TIULINE,"-",81)=""
+3 WRITE ?21,$SELECT(+$GET(TIUCONT1):"** THIS NOTE CONTINUED ON NEXT PAGE **",1:""),!
+4 IF '+$GET(TIUFLAG)
WRITE "WORK COPY ========== UNOFFICIAL "
+5 IF $TEST
WRITE "- NOT FOR MEDICAL RECORD =========== DO NOT FILE"
+6 IF '$TEST
WRITE TIULINE
+7 WRITE !,TIUFOOT("PNMP")
+8 ; **100**
SET LOC=$SELECT($LENGTH(TIUROOT):$GET(@TIUROOT@(1205,"I")),1:"")
+9 IF LOC
Begin DoDot:1
+10 SET DIV=+$PIECE($GET(^SC(LOC,0)),U,15)
+11 SET TIUDIV=+$ORDER(^TIU(8925.94,"B",DIV,0))
End DoDot:1
+12 IF $GET(TIUDIV)
IF $PIECE($GET(^TIU(8925.94,TIUDIV,0)),U,2)]""
SET TIUDIVI=$PIECE(^(0),U,2)
+13 SET TIUPRTNM=$SELECT($GET(TIUDIVI)]"":TIUDIVI,$GET(TIUFOOT("INTNM"))]"":TIUFOOT("INTNM"),1:TIUFOOT("SITE"))
+14 SET TIUPRTDT="Printed:"_$$DATE^TIULS($$NOW^TIULC,"MM/DD/CCYY HR:MIN")
+15 IF $LENGTH(TIUPRTNM)<36
Begin DoDot:1
+16 WRITE ?(80-$LENGTH(TIUPRTNM)\2),TIUPRTNM,?56,TIUPRTDT
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 WRITE ?58,TIUPRTDT,!?(80-$LENGTH(TIUPRTNM)\2),TIUPRTNM
End DoDot:1
+19 ; *222 only print if NOT WORKCOPY
IF +$GET(TIUFLAG)
WRITE !,TIUFOOT("SSN")," ",TIUFOOT("DOB"),?(80-$LENGTH(TIUFOOT("LOCP"))\2),TIUFOOT("LOCP")
+20 IF '+$GET(TIUFLAG)
WRITE !,?(80-$LENGTH(TIUFOOT("LOCP"))\2),TIUFOOT("LOCP")
+21 IF +$GET(TIUFLAG)
WRITE ?(80-$LENGTH(TIUPFNBR)),TIUPFNBR
+22 IF '+$GET(TIUFLAG)
WRITE ?(80-$LENGTH(TIUFOOT("PH#"))),TIUFOOT("PH#")
+23 IF +$GET(TIUFLAG)
WRITE !,TIULINE
+24 IF '$TEST
WRITE !,"=========================== CONFIDENTIAL INFORMATION ==========================="
+25 WRITE @IOF
IF +$GET(TIUCONT)
DO HEADER(.TIUFOOT,TIUFLAG,.TIUPFHDR,TIUCONT1,$GET(TIUROOT))
+1 QUIT TIUCONT
+1 ; Requires array TIUFOOT, vars TIUFLAG,TIUPFHDR,TIUCONT1
+2 NEW TIULINE
SET $PIECE(TIULINE,"-",81)=""
+3 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+4 WRITE @IOF,$CHAR(13),TIULINE,!,TIUFOOT("PNMP")_" "_TIUFOOT("SSN")
+5 WRITE ?(78-$LENGTH(TIUPFHDR)),TIUPFHDR,!,TIULINE,!
+6 IF +$GET(TIUCONT1)
WRITE $$DATE^TIULS(@TIUROOT@(1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS SCREEN **",!
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 WRITE !,TIULINE,!,$SELECT('+$GET(TIUFLAG):"** WORK COPY - NOT FOR ",1:"")
+9 WRITE "MEDICAL RECORD"
if '+$GET(TIUFLAG)
WRITE " **"
WRITE ?(80-$LENGTH(TIUPFHDR)),TIUPFHDR
+10 WRITE !,TIULINE,!
+11 IF +$GET(TIUCONT1)
WRITE $$DATE^TIULS(@TIUROOT@(1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS PAGE **",!!
End DoDot:1
+12 QUIT
STOP() ;on screen paging check
+1 ; quits TIUCONT=1 if cont. ELSE quits TIUCONT=0
+2 NEW DIR,Y,TIUCONT
+3 SET DIR(0)="E"
if +$GET(TIUKID)
WRITE !
DO ^DIR
+4 SET TIUCONT=Y
+5 QUIT TIUCONT
