Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROESPR2

SROESPR2.m

Go to the documentation of this file.
  1. SROESPR2 ;BIR/ADM - SURGERY E-SIG UTILITY ; [ 06/25/02 04:09 PM ]
  1. ;;3.0; Surgery ;**100**;24 Jun 93
  1. ;
  1. ;** NOTICE: This routine is part of an implementation of a nationally
  1. ;** controlled procedure. Local modifications to this routine
  1. ;** are prohibited.
  1. ;
  1. ; This routine was cloned in part or in whole from TIUPRPN2.
  1. ; position, write footer when appropriate
  1. ; IF SRHDR=1, HEADER WILL NOT BE PRINTED
  1. S SRCONT=1
  1. I $E(IOST)="C" G FOOTX:$Y+3<IOSL S SRCONT=$$STOP G FOOTW
  1. G FTR:+$G(SRHDR)
  1. G:$Y+7<IOSL FOOTX
  1. FTR I (IOT'="HFS")!(IOSL<250) F Q:$Y+6'<IOSL W ! ;moves ftr to pg bottom
  1. N SRFNUM,SRLINE,LOC,DIV,SRDIV,SRDIVI,SRPRTDT,SRPRTNM,SRNOW,SRCASE
  1. S $P(SRLINE,"-",81)=""
  1. W ?21,$S(+$G(SRCONT1):"** THIS NOTE CONTINUED ON NEXT PAGE **",1:""),!
  1. I '+$G(SRFLAG) W "WORK COPY ========== UNOFFICIAL "
  1. I W "- NOT FOR MEDICAL RECORD =========== DO NOT FILE"
  1. E W SRLINE
  1. W !,SRFOOT("PNMP")
  1. 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)
  1. I SRDIVI="",$G(^TMP("SRLQ",$J,SRDA,1205,"I")) S LOC=+^("I") D
  1. .S SRDIV=+$P($G(^SC(LOC,0)),U,4) I SRDIV S SRDIVI=$$GET1^DIQ(4,SRDIV,.01)
  1. S SRPRTNM=$S($G(SRDIVI)]"":SRDIVI,$G(SRFOOT("INTNM"))]"":SRFOOT("INTNM"),1:SRFOOT("SITE"))
  1. S SRNOW=$$NOW^XLFDT,SRPRTDT="Printed:"_$$DATE^SROESPR(SRNOW,"MM/DD/CCYY HR:MIN")
  1. I $L(SRPRTNM)<36 D
  1. . W ?(80-$L(SRPRTNM)\2),SRPRTNM,?56,SRPRTDT
  1. ELSE D
  1. . W ?58,SRPRTDT,!?(80-$L(SRPRTNM)\2),SRPRTNM
  1. W !,SRFOOT("SSN")," ",SRFOOT("DOB"),?(80-$L(SRFOOT("LOCP"))\2),SRFOOT("LOCP")
  1. I +$G(SRFLAG) W ?(80-$L(SRPFNBR)),SRPFNBR
  1. I '+$G(SRFLAG) W ?(80-$L(SRFOOT("PH#"))),SRFOOT("PH#")
  1. I +$G(SRFLAG) W !,SRLINE
  1. E W !,"=========================== CONFIDENTIAL INFORMATION ==========================="
  1. W @IOF
  1. FOOTW I '+$G(SRHDR),+$G(SRCONT) D HEADER(.SRFOOT,SRFLAG,.SRPFHDR,.SRCONT1)
  1. FOOTX ;
  1. Q SRCONT
  1. N SRLINE S $P(SRLINE,"-",81)="",SROPAGE=+$G(SROPAGE)+1
  1. I $E(IOST)="C" D
  1. .W @IOF,!,?71,"Page: ",$J(SROPAGE,2)
  1. .W !,SRLINE,!,SRFOOT("PNMP")_" "_SRFOOT("SSN")
  1. .W ?(78-$L(SRPFHDR)),SRPFHDR,!,SRLINE,!
  1. .I +$G(SRCONT1) W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS SCREEN **",!
  1. E D
  1. .W !?71,"Page: ",$J(SROPAGE,2)
  1. .W !,SRLINE,!,$S('+$G(SRFLAG):"** WORK COPY - NOT FOR ",1:"")
  1. .W "MEDICAL RECORD" W:'+$G(SRFLAG) " **" W ?(80-$L(SRPFHDR)),SRPFHDR
  1. .W !,SRLINE,!
  1. .I +$G(SRCONT1) W $$DATE^SROESPR(^TMP("SRLQ",$J,SRDA,1301,"I"),"MM/DD/CCYY HR:MIN"),?21,"** CONTINUED FROM PREVIOUS PAGE **",!!
  1. K SRCONT1
  1. Q
  1. STOP() ;on screen paging check
  1. ; quits SRCONT=1 if cont. ELSE quits SRCONT=0
  1. N DIR,Y
  1. S DIR(0)="E" D ^DIR
  1. S SRCONT=Y
  1. Q SRCONT