- 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 Feb 19, 2025@00:10:08 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