TIUPRDS2.m

TIUPRDS2 ;SLC/SBW - Header & Footer for Form 10-1000 ; 11/29/02

 ;;1.0;TEXT INTEGRATION UTILITIES;**7,55,52,148**;Jun 20, 1997

FOOTER(TIUDA,TIU,TIUFLAG,TIUPAGE,TIUCOPY,TIUHDR) ; Control Pagination

 ; 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)

FOOTEXIT ;

 Q TIUCONT

HEADER(TIUDA,TIU,TIUFLAG,TIUPAGE) ; Header

 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

HEADERX ;Header exit

 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 ---TIUPRDS2   2559     printed  Apr 09, 2024@21:48:33                                                                                                                                                                                                    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

FOOTER(TIUDA,TIU,TIUFLAG,TIUPAGE,TIUCOPY,TIUHDR) ; Control Pagination

 +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)

FOOTEXIT  ;

 +1        QUIT TIUCONT

HEADER(TIUDA,TIU,TIUFLAG,TIUPAGE) ; Header

 +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

HEADERX   ;Header exit

 +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