TIUPRPN2.m

TIUPRPN2 ;SLC/MJC - Header/Footer for Progress Notes ;31-Dec-2012 15:16;DU

 ;;1.0;TEXT INTEGRATION UTILITIES;**44,45,52,100,222,1011**;Jun 20, 1997;Build 13

 ;IHS/ITSC/LJF 05/07/2003 changed SSN to HRCN

FOOTER(TIUFOOT,TIUMISC,TIUCONT1,TIUHDR,TIUROOT) ; Function returns TIUCONT

 ; 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 IHS/ITSC/LJF 05/07/2003

 I +$G(TIUFLAG) W !,TIUFOOT("HRCN")," ",TIUFOOT("DOB"),?(80-$L(TIUFOOT("LOCP"))\2),TIUFOOT("LOCP")   ;IHS/ITSC/LJF 05/07/2003

 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

FOOTW I '+$G(TIUHDR),+$G(TIUCONT) D HEADER(.TIUFOOT,TIUFLAG,.TIUPFHDR,TIUCONT1,$G(TIUROOT))

FOOTX ;

 Q TIUCONT

HEADER(TIUFOOT,TIUFLAG,TIUPFHDR,TIUCONT1,TIUROOT) ; Header

 ; 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")   ;IHS/ITSC/LJF 05/07/2003

 .W @IOF,$C(13),TIULINE,!,TIUFOOT("PNMP")_"  "_TIUFOOT("HRCN")   ;IHS/ITSC/LJF 05/07/2003

 .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

TIUPRPN2  ;SLC/MJC - Header/Footer for Progress Notes ;31-Dec-2012 15:16;DU

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**44,45,52,100,222,1011**;Jun 20, 1997;Build 13

 +2       ;IHS/ITSC/LJF 05/07/2003 changed SSN to HRCN

FOOTER(TIUFOOT,TIUMISC,TIUCONT1,TIUHDR,TIUROOT) ; Function returns TIUCONT

 +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      ;I +$G(TIUFLAG) W !,TIUFOOT("SSN")," ",TIUFOOT("DOB"),?(80-$L(TIUFOOT("LOCP"))\2),TIUFOOT("LOCP") ; *222 only print if NOT WORKCOPY IHS/ITSC/LJF 05/07/2003

 +20      ;IHS/ITSC/LJF 05/07/2003

           IF +$GET(TIUFLAG)

               WRITE !,TIUFOOT("HRCN")," ",TIUFOOT("DOB"),?(80-$LENGTH(TIUFOOT("LOCP"))\2),TIUFOOT("LOCP")

 +21       IF '+$GET(TIUFLAG)

               WRITE !,?(80-$LENGTH(TIUFOOT("LOCP"))\2),TIUFOOT("LOCP")

 +22       IF +$GET(TIUFLAG)

               WRITE ?(80-$LENGTH(TIUPFNBR)),TIUPFNBR

 +23       IF '+$GET(TIUFLAG)

               WRITE ?(80-$LENGTH(TIUFOOT("PH#"))),TIUFOOT("PH#")

 +24       IF +$GET(TIUFLAG)

               WRITE !,TIULINE

 +25      IF '$TEST

               WRITE !,"=========================== CONFIDENTIAL INFORMATION ==========================="

 +26       WRITE @IOF

FOOTW      IF '+$GET(TIUHDR)

               IF +$GET(TIUCONT)

                   DO HEADER(.TIUFOOT,TIUFLAG,.TIUPFHDR,TIUCONT1,$GET(TIUROOT))

FOOTX     ;

 +1        QUIT TIUCONT

HEADER(TIUFOOT,TIUFLAG,TIUPFHDR,TIUCONT1,TIUROOT) ; Header

 +1       ; Requires array TIUFOOT, vars TIUFLAG,TIUPFHDR,TIUCONT1

 +2        NEW TIULINE

           SET $PIECE(TIULINE,"-",81)=""

 +3        IF $EXTRACT(IOST)="C"

               Begin DoDot:1

 +4       ;W @IOF,$C(13),TIULINE,!,TIUFOOT("PNMP")_"  "_TIUFOOT("SSN")   ;IHS/ITSC/LJF 05/07/2003

 +5       ;IHS/ITSC/LJF 05/07/2003

                   WRITE @IOF,$CHAR(13),TIULINE,!,TIUFOOT("PNMP")_"  "_TIUFOOT("HRCN")

 +6                WRITE ?(78-$LENGTH(TIUPFHDR)),TIUPFHDR,!,TIULINE,!

 +7                IF +$GET(TIUCONT1)

                       WRITE $$DATE^TIULS(@TIUROOT@(1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS SCREEN **",!

               End DoDot:1

 +8       IF '$TEST

               Begin DoDot:1

 +9                WRITE !,TIULINE,!,$SELECT('+$GET(TIUFLAG):"** WORK COPY - NOT FOR ",1:"")

 +10               WRITE "MEDICAL RECORD"

                   IF '+$GET(TIUFLAG)

                       WRITE " **"

                   WRITE ?(80-$LENGTH(TIUPFHDR)),TIUPFHDR

 +11               WRITE !,TIULINE,!

 +12               IF +$GET(TIUCONT1)

                       WRITE $$DATE^TIULS(@TIUROOT@(1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS PAGE **",!!

               End DoDot:1

 +13       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