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