TIUPRDS2 ;SLC/SBW - Header & Footer for Form 10-1000 ; 11/29/02
;;1.0;TEXT INTEGRATION UTILITIES;**7,55,52,148**;Jun 20, 1997
; position, write footer when appropriate
; IF TIUHDR=1, HEADER WILL NOT BE PRINTED
S TIUCONT=1 G:$Y+TIUY'>IOSL FOOTEXIT
I (IOT'="HFS")!(IOSL<250) F Q:$Y+4>IOSL W ! ;moves ftr to pg bottom
I $E(IOST)="P" D
. W !,"PATIENT: ",^TMP("TIULQ",$J,TIUDA,.02,"E")
. W ?47,"VA FORM 10-1000 DISCHARGE SUMMARY"
. W !,TIU("SSN")," DOB: ",$$DATE^TIULS(+$G(TIU("DOB")),"MM/DD/CCYY")
W ?40,$J(TIUCOPY,39)
I $E(IOST)="C" S TIUCONT=$$STOP^TIUU G FOOTEXIT:'TIUCONT
W @IOF
D:'+$G(TIUHDR) HEADER(TIUDA,.TIU,TIUFLAG,.TIUPAGE)
Q TIUCONT
N TIULINE,TIUADT,TIUENTDT S $P(TIULINE,"-",80)=""
S TIUENTDT=+$G(^TIU(8925,+TIUDA,12))
S TIUADT=$S(+$G(TIU("LDT")):TIU("LDT"),+TIUENTDT:TIUENTDT,+$G(TIU("EDT")):TIU("EDT"),1:0)
I +$G(TIU("DOB")),+TIUADT S TIU("AGE")=$$AGE(TIUADT,+$G(TIU("DOB")))
W:'+TIUFLAG&($E(IOST)="P") ?26,"** WORK COPY - NOT FOR MEDICAL RECORD **"
W !,$E($P($G(TIU("DIV")),U,2),1,37),?$X+3,$S(^TMP("TIULQ",$J,TIUDA,.09,"I")="P":^("E"),1:"")
W ?50,$$DATE^TIULS($$NOW^TIULC,"MM/DD/CCYY HR:MIN"),?71,"Page: ",$J(TIUPAGE,2)
W !,TIULINE
; Removed RACE from header **148**
W !,"PATIENT NAME",?33,"| AGE | SEX | SSN | CLAIM NUMBER"
W !,^TMP("TIULQ",$J,TIUDA,.02,"E"),?33,"| ",$J($G(TIU("AGE")),3),?39,"|",?42,$P($G(TIU("SEX")),U),?45,"| ",$P($G(TIU("SSN")),U),?60,"| ",$G(TIU("CLAIM"))
W !,TIULINE
G:$E(IOST)="C"&(TIUPAGE>1) HEADERX ;Next lines not displayed on screen if page > 0
W !?2,"ADM DATE | DISC DATE | TYPE OF RELEASE | INP | ABS | WARD NO"
W !,$P(^TMP("TIULQ",$J,TIUDA,.07,"E"),"@"),?13,"| ",$P(^TMP("TIULQ",$J,TIUDA,.08,"E"),"@"),?28,"| "
W $S($G(^TMP("TIULQ",$J,TIUDA,.08,"E"))]"":$$DISPTYP($P($G(TIU("MTYPE")),U,2)),1:" "),?48,"|"
W ?49,$J($P($G(TIU("DAYS")),U),4),?54,"|",?55,$J($P($G(TIU("DAYS")),U,4),4),?60,"| ",$E($P($G(TIU("WARD")),U,2),1,18)
W !,TIULINE
S TIUPAGE=TIUPAGE+1
Q
AGE(TIUDT,TIUDOB) ; Compute patient's age as of discharge (or entry)
N Y S Y=$$FMDIFF^XLFDT(TIUDT,TIUDOB)\365.25
Q Y
DISPTYP(TEXT) ; NOIS SHE-1098-52553
N TIUY
I TEXT="NON-SERVICE CONNECTED (OPT-NSC)" S TIUY="NON-SERV (OPT-NSC)"
E I TEXT="CONTINUED ASIH (OTHER FACILITY)" S TIUY="CONTINUED ASIH"
E I TEXT="DISCHARGE FROM NHCU/DOM WHILE ASIH" S TIUY="DISC NHCU/DOM ASIH"
E S TIUY=$E(TEXT,1,18)
Q TIUY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPRDS2 2559 printed Dec 13, 2024@02:43:38 Page 2
TIUPRDS2 ;SLC/SBW - Header & Footer for Form 10-1000 ; 11/29/02
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**7,55,52,148**;Jun 20, 1997
+1 ; position, write footer when appropriate
+2 ; IF TIUHDR=1, HEADER WILL NOT BE PRINTED
+3 SET TIUCONT=1
if $Y+TIUY'>IOSL
GOTO FOOTEXIT
+4 ;moves ftr to pg bottom
IF (IOT'="HFS")!(IOSL<250)
FOR
if $Y+4>IOSL
QUIT
WRITE !
+5 IF $EXTRACT(IOST)="P"
Begin DoDot:1
+6 WRITE !,"PATIENT: ",^TMP("TIULQ",$JOB,TIUDA,.02,"E")
+7 WRITE ?47,"VA FORM 10-1000 DISCHARGE SUMMARY"
+8 WRITE !,TIU("SSN")," DOB: ",$$DATE^TIULS(+$GET(TIU("DOB")),"MM/DD/CCYY")
End DoDot:1
+9 WRITE ?40,$JUSTIFY(TIUCOPY,39)
+10 IF $EXTRACT(IOST)="C"
SET TIUCONT=$$STOP^TIUU
if 'TIUCONT
GOTO FOOTEXIT
+11 WRITE @IOF
+12 if '+$GET(TIUHDR)
DO HEADER(TIUDA,.TIU,TIUFLAG,.TIUPAGE)
+1 QUIT TIUCONT
+1 NEW TIULINE,TIUADT,TIUENTDT
SET $PIECE(TIULINE,"-",80)=""
+2 SET TIUENTDT=+$GET(^TIU(8925,+TIUDA,12))
+3 SET TIUADT=$SELECT(+$GET(TIU("LDT")):TIU("LDT"),+TIUENTDT:TIUENTDT,+$GET(TIU("EDT")):TIU("EDT"),1:0)
+4 IF +$GET(TIU("DOB"))
IF +TIUADT
SET TIU("AGE")=$$AGE(TIUADT,+$GET(TIU("DOB")))
+5 if '+TIUFLAG&($EXTRACT(IOST)="P")
WRITE ?26,"** WORK COPY - NOT FOR MEDICAL RECORD **"
+6 WRITE !,$EXTRACT($PIECE($GET(TIU("DIV")),U,2),1,37),?$X+3,$SELECT(^TMP("TIULQ",$JOB,TIUDA,.09,"I")="P":^("E"),1:"")
+7 WRITE ?50,$$DATE^TIULS($$NOW^TIULC,"MM/DD/CCYY HR:MIN"),?71,"Page: ",$JUSTIFY(TIUPAGE,2)
+8 WRITE !,TIULINE
+9 ; Removed RACE from header **148**
+10 WRITE !,"PATIENT NAME",?33,"| AGE | SEX | SSN | CLAIM NUMBER"
+11 WRITE !,^TMP("TIULQ",$JOB,TIUDA,.02,"E"),?33,"| ",$JUSTIFY($GET(TIU("AGE")),3),?39,"|",?42,$PIECE($GET(TIU("SEX")),U),?45,"| ",$PIECE($GET(TIU("SSN")),U),?60,"| ",$GET(TIU("CLAIM"))
+12 WRITE !,TIULINE
+13 ;Next lines not displayed on screen if page > 0
if $EXTRACT(IOST)="C"&(TIUPAGE>1)
GOTO HEADERX
+14 WRITE !?2,"ADM DATE | DISC DATE | TYPE OF RELEASE | INP | ABS | WARD NO"
+15 WRITE !,$PIECE(^TMP("TIULQ",$JOB,TIUDA,.07,"E"),"@"),?13,"| ",$PIECE(^TMP("TIULQ",$JOB,TIUDA,.08,"E"),"@"),?28,"| "
+16 WRITE $SELECT($GET(^TMP("TIULQ",$JOB,TIUDA,.08,"E"))]"":$$DISPTYP($PIECE($GET(TIU("MTYPE")),U,2)),1:" "),?48,"|"
+17 WRITE ?49,$JUSTIFY($PIECE($GET(TIU("DAYS")),U),4),?54,"|",?55,$JUSTIFY($PIECE($GET(TIU("DAYS")),U,4),4),?60,"| ",$EXTRACT($PIECE($GET(TIU("WARD")),U,2),1,18)
+18 WRITE !,TIULINE
+1 SET TIUPAGE=TIUPAGE+1
+2 QUIT
AGE(TIUDT,TIUDOB) ; Compute patient's age as of discharge (or entry)
+1 NEW Y
SET Y=$$FMDIFF^XLFDT(TIUDT,TIUDOB)\365.25
+2 QUIT Y
DISPTYP(TEXT) ; NOIS SHE-1098-52553
+1 NEW TIUY
+2 IF TEXT="NON-SERVICE CONNECTED (OPT-NSC)"
SET TIUY="NON-SERV (OPT-NSC)"
+3 IF '$TEST
IF TEXT="CONTINUED ASIH (OTHER FACILITY)"
SET TIUY="CONTINUED ASIH"
+4 IF '$TEST
IF TEXT="DISCHARGE FROM NHCU/DOM WHILE ASIH"
SET TIUY="DISC NHCU/DOM ASIH"
+5 IF '$TEST
SET TIUY=$EXTRACT(TEXT,1,18)
+6 QUIT TIUY
