SROESPR2.m

SROESPR2 ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 06/25/02  04:09 PM ]

 ;;3.0; Surgery ;**100**;24 Jun 93

 ;

 ;** NOTICE: This routine is part of an implementation of a nationally

 ;**         controlled procedure.  Local modifications to this routine

 ;**         are prohibited.

 ;

 ; This routine was cloned in part or in whole from TIUPRPN2.

FOOTER(SRFOOT,SRFLAG,SRPFNBR,SRHDR,SRCONT1,SRDA) ; Control Pagination

 ; position, write footer when appropriate

 ; IF SRHDR=1, HEADER WILL NOT BE PRINTED

 S SRCONT=1

 I $E(IOST)="C" G FOOTX:$Y+3<IOSL S SRCONT=$$STOP G FOOTW

 G FTR:+$G(SRHDR)

 G:$Y+7<IOSL FOOTX

FTR I (IOT'="HFS")!(IOSL<250) F  Q:$Y+6'<IOSL  W ! ;moves ftr to pg bottom

 N SRFNUM,SRLINE,LOC,DIV,SRDIV,SRDIVI,SRPRTDT,SRPRTNM,SRNOW,SRCASE

 S $P(SRLINE,"-",81)=""

 W ?21,$S(+$G(SRCONT1):"** THIS NOTE CONTINUED ON NEXT PAGE **",1:""),!

 I '+$G(SRFLAG) W "WORK COPY ========== UNOFFICIAL "

 I  W "- NOT FOR MEDICAL RECORD =========== DO NOT FILE"

 E  W SRLINE

 W !,SRFOOT("PNMP")

 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)

 I SRDIVI="",$G(^TMP("SRLQ",$J,SRDA,1205,"I")) S LOC=+^("I") D

 .S SRDIV=+$P($G(^SC(LOC,0)),U,4) I SRDIV S SRDIVI=$$GET1^DIQ(4,SRDIV,.01)

 S SRPRTNM=$S($G(SRDIVI)]"":SRDIVI,$G(SRFOOT("INTNM"))]"":SRFOOT("INTNM"),1:SRFOOT("SITE"))

 S SRNOW=$$NOW^XLFDT,SRPRTDT="Printed:"_$$DATE^SROESPR(SRNOW,"MM/DD/CCYY HR:MIN")

 I $L(SRPRTNM)<36 D

 . W ?(80-$L(SRPRTNM)\2),SRPRTNM,?56,SRPRTDT

 ELSE  D

 . W ?58,SRPRTDT,!?(80-$L(SRPRTNM)\2),SRPRTNM

 W !,SRFOOT("SSN")," ",SRFOOT("DOB"),?(80-$L(SRFOOT("LOCP"))\2),SRFOOT("LOCP")

 I +$G(SRFLAG) W ?(80-$L(SRPFNBR)),SRPFNBR

 I '+$G(SRFLAG) W ?(80-$L(SRFOOT("PH#"))),SRFOOT("PH#")

 I +$G(SRFLAG) W !,SRLINE

 E  W !,"=========================== CONFIDENTIAL INFORMATION ==========================="

 W @IOF

FOOTW I '+$G(SRHDR),+$G(SRCONT) D HEADER(.SRFOOT,SRFLAG,.SRPFHDR,.SRCONT1)

FOOTX ;

 Q SRCONT

HEADER(SRFOOT,SRFLAG,SRPFHDR,SRCONT1) ; Header

 N SRLINE S $P(SRLINE,"-",81)="",SROPAGE=+$G(SROPAGE)+1

 I $E(IOST)="C" D

 .W @IOF,!,?71,"Page: ",$J(SROPAGE,2)

 .W !,SRLINE,!,SRFOOT("PNMP")_"  "_SRFOOT("SSN")

 .W ?(78-$L(SRPFHDR)),SRPFHDR,!,SRLINE,!

 .I +$G(SRCONT1) W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS SCREEN **",!

 E  D

 .W !?71,"Page: ",$J(SROPAGE,2)

 .W !,SRLINE,!,$S('+$G(SRFLAG):"** WORK COPY - NOT FOR ",1:"")

 .W "MEDICAL RECORD" W:'+$G(SRFLAG) " **" W ?(80-$L(SRPFHDR)),SRPFHDR

 .W !,SRLINE,!

 .I +$G(SRCONT1) W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS PAGE **",!!

 K SRCONT1

 Q

STOP() ;on screen paging check

 ; quits SRCONT=1 if cont. ELSE quits SRCONT=0

 N DIR,Y

 S DIR(0)="E" D ^DIR

 S SRCONT=Y

 Q SRCONT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROESPR2   2891     printed  Apr 09, 2024@21:49:48                                                                                                                                                                                                    Page 2

SROESPR2  ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 06/25/02  04:09 PM ]

 +1       ;;3.0; Surgery ;**100**;24 Jun 93

 +2       ;

 +3       ;** NOTICE: This routine is part of an implementation of a nationally

 +4       ;**         controlled procedure.  Local modifications to this routine

 +5       ;**         are prohibited.

 +6       ;

 +7       ; This routine was cloned in part or in whole from TIUPRPN2.

FOOTER(SRFOOT,SRFLAG,SRPFNBR,SRHDR,SRCONT1,SRDA) ; Control Pagination

 +1       ; position, write footer when appropriate

 +2       ; IF SRHDR=1, HEADER WILL NOT BE PRINTED

 +3        SET SRCONT=1

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

               if $Y+3<IOSL

                   GOTO FOOTX

               SET SRCONT=$$STOP

               GOTO FOOTW

 +5        if +$GET(SRHDR)

               GOTO FTR

 +6        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 SRFNUM,SRLINE,LOC,DIV,SRDIV,SRDIVI,SRPRTDT,SRPRTNM,SRNOW,SRCASE

 +2        SET $PIECE(SRLINE,"-",81)=""

 +3        WRITE ?21,$SELECT(+$GET(SRCONT1):"** THIS NOTE CONTINUED ON NEXT PAGE **",1:""),!

 +4        IF '+$GET(SRFLAG)

               WRITE "WORK COPY ========== UNOFFICIAL "

 +5       IF $TEST

               WRITE "- NOT FOR MEDICAL RECORD =========== DO NOT FILE"

 +6       IF '$TEST

               WRITE SRLINE

 +7        WRITE !,SRFOOT("PNMP")

 +8        SET SRDIVI=""

           SET SRCASE=$PIECE($GET(^TMP("SRLQ",$JOB,SRDA,1405,"I")),";")

           if SRCASE

               SET DIV=$$SITE^SROUTL0(SRCASE)

           IF DIV

               SET SRDIV=$PIECE(^SRO(133,DIV,0),"^")

               SET SRDIVI=$$EXTERNAL^DILFD(133,.01,"",SRDIV)

 +9        IF SRDIVI=""

               IF $GET(^TMP("SRLQ",$JOB,SRDA,1205,"I"))

                   SET LOC=+^("I")

                   Begin DoDot:1

 +10                   SET SRDIV=+$PIECE($GET(^SC(LOC,0)),U,4)

                       IF SRDIV

                           SET SRDIVI=$$GET1^DIQ(4,SRDIV,.01)

                   End DoDot:1

 +11       SET SRPRTNM=$SELECT($GET(SRDIVI)]"":SRDIVI,$GET(SRFOOT("INTNM"))]"":SRFOOT("INTNM"),1:SRFOOT("SITE"))

 +12       SET SRNOW=$$NOW^XLFDT

           SET SRPRTDT="Printed:"_$$DATE^SROESPR(SRNOW,"MM/DD/CCYY HR:MIN")

 +13       IF $LENGTH(SRPRTNM)<36

               Begin DoDot:1

 +14               WRITE ?(80-$LENGTH(SRPRTNM)\2),SRPRTNM,?56,SRPRTDT

               End DoDot:1

 +15      IF '$TEST

               Begin DoDot:1

 +16               WRITE ?58,SRPRTDT,!?(80-$LENGTH(SRPRTNM)\2),SRPRTNM

               End DoDot:1

 +17       WRITE !,SRFOOT("SSN")," ",SRFOOT("DOB"),?(80-$LENGTH(SRFOOT("LOCP"))\2),SRFOOT("LOCP")

 +18       IF +$GET(SRFLAG)

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

 +19       IF '+$GET(SRFLAG)

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

 +20       IF +$GET(SRFLAG)

               WRITE !,SRLINE

 +21      IF '$TEST

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

 +22       WRITE @IOF

FOOTW      IF '+$GET(SRHDR)

               IF +$GET(SRCONT)

                   DO HEADER(.SRFOOT,SRFLAG,.SRPFHDR,.SRCONT1)

FOOTX     ;

 +1        QUIT SRCONT

HEADER(SRFOOT,SRFLAG,SRPFHDR,SRCONT1) ; Header

 +1        NEW SRLINE

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

           SET SROPAGE=+$GET(SROPAGE)+1

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

               Begin DoDot:1

 +3                WRITE @IOF,!,?71,"Page: ",$JUSTIFY(SROPAGE,2)

 +4                WRITE !,SRLINE,!,SRFOOT("PNMP")_"  "_SRFOOT("SSN")

 +5                WRITE ?(78-$LENGTH(SRPFHDR)),SRPFHDR,!,SRLINE,!

 +6                IF +$GET(SRCONT1)

                       WRITE $$DATE^SROESPR(^TMP("SRLQ",$JOB,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS SCREEN **",!

               End DoDot:1

 +7       IF '$TEST

               Begin DoDot:1

 +8                WRITE !?71,"Page: ",$JUSTIFY(SROPAGE,2)

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

 +10               WRITE "MEDICAL RECORD"

                   if '+$GET(SRFLAG)

                       WRITE " **"

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

 +11               WRITE !,SRLINE,!

 +12               IF +$GET(SRCONT1)

                       WRITE $$DATE^SROESPR(^TMP("SRLQ",$JOB,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS PAGE **",!!

               End DoDot:1

 +13       KILL SRCONT1

 +14       QUIT 

STOP()    ;on screen paging check

 +1       ; quits SRCONT=1 if cont. ELSE quits SRCONT=0

 +2        NEW DIR,Y

 +3        SET DIR(0)="E"

           DO ^DIR

 +4        SET SRCONT=Y

 +5        QUIT SRCONT