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.
; 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
Q SRCONT
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 ---[H[J[2J[HSROESPR2 2891 printed Oct 16, 2024@18:44:18 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.
+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
IF +$GET(SRCONT)
DO HEADER(.SRFOOT,SRFLAG,.SRPFHDR,.SRCONT1)
+1 QUIT SRCONT
+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
