NURARPC2.m

NURARPC2 ;HIRMFO/MD-CONTINUATION OF DRIVER TO PRINT AMIS 1106 ACUITY REPORTS ;5/9/97

 ;;4.0;NURSING SERVICE;**1**;Apr 25, 1997

 U IO D PRINTRPT

 Q

HEADER ; HEADINGS

 I $E(IOST)="C",'NURMDSW(1) D ENDPG^NURSUT1 Q:NUROUT

 S HDRDT=$S(+NDATED'=$P(NDATED,U,2):"FROM ",1:"")_$E(+NDATED,4,5)_"/"_$E(+NDATED,6,7)_"/"_$E(+NDATED,2,3)_$S(+NDATED'=$P(NDATED,U,2):" - "_$E($P(NDATED,U,2),4,5)_"/"_$E($P(NDATED,U,2),6,7)_"/"_$E($P(NDATED,U,2),2,3),1:"")

 I $D(NDATED),+NDATED?7N S:'$D(NURTYPE) NURTYPE=0 S NURSHDR=$S(NURTYPE=0:"AMIS ",1:"Midnight Acuity ")_"Daily Report for "_HDRDT

 S NURMDSW(1)=0,NURPAGE=NURPAGE+1 S Y=DT D:+Y D^DIQ W:$E(IOST)="C"!(NURPAGE>1) @IOF

 S NURSHDR(1)="Report 10-1106 Segment 200",NURSHDR(2)="Cumulative Daily Patient Classification Data"

 I NURMDSW,NHOSPSW,$G(NURFAC(2))'="",'$G(NURSUMSW) W ?$$CNTR^NURSUT2(NURFAC(2)),$S(NURFAC(2)="  BLANK":"NO FACILITY",1:NURFAC(2))

 W !!,Y,?(80-$L(NURSHDR(1)))\2,NURSHDR(1),?70,"PAGE: ",NURPAGE,!,?(80-$L(NURSHDR(2)))\2,NURSHDR(2),!,?(80-$L(NURSHDR))\2,NURSHDR,!

 Q

HEADER1 W !,?72,"PATIENT",! W:$G(HDATE(1))?7N&'($G(NURSUMSW)) "Date: ",$E(HDATE(1),4,5)_"/"_$E(HDATE(1),6,7)_"/"_$E(HDATE(1),2,3) W ?22,"CATEGORY      I      II     III      IV       V   CLASS."

 Q

PRINTRPT ; PRINT REPORT

 S HDATE(1)=0 F  S HDATE(1)=$O(^TMP($J,HDATE(1))) Q:HDATE(1)'>0  D:'NURMDSW HEADER Q:NUROUT  D:'NURMDSW HEADER1 D L0 Q:NUROUT  I NHOSPSW D BRK1 Q:NUROUT

 Q

L0 S NURFAC(2)="" F  S NURFAC(2)=$O(^TMP($J,HDATE(1),NURFAC(2))) Q:NURFAC(2)=""  D:NURMDSW&'($G(NURSUMSW)) HEADER Q:NUROUT  D:NURMDSW&'($G(NURSUMSW)) HEADER1 D L1 Q:NUROUT  I NHOSPSW,NURMDSW D BRK2 Q:NUROUT

 Q

L1 S NF1="" F  S NF1=$O(^TMP($J,HDATE(1),NURFAC(2),NF1)) Q:NF1=""  D L2 Q:NUROUT  D BRK Q:NUROUT

 Q

L2 S NF2="" F  S NF2=$O(^TMP($J,HDATE(1),NURFAC(2),NF1,NF2)) Q:NF2=""  D WRITE Q:NUROUT

 Q

WRITE I NURMDSW(1)!($Y>(IOSL-6)) D HEADER Q:NUROUT  D HEADER1

 S NDATA=^TMP($J,HDATE(1),NURFAC(2),NF1,NF2)

 S NC(1)=+$P(NDATA,U),NC(2)=+$P(NDATA,U,2),NC(3)=+$P(NDATA,U,3),NC(4)=+$P(NDATA,U,4),NC(5)=+$P(NDATA,U,5) S NCEN=0,NCEN=NCEN+NC(1)+NC(2)+NC(3)+NC(4)+NC(5)

 G:$G(NURSUMSW) D

 I NURMDSW(2),NURSTYPE="U" W !,"WARD: ",$S(NBDSECT="":NF1,1:NF2) G B

 I NURMDSW(2) W !,"BED SECTION: ",NF1

B I NURSTYPE="B" W !,?6,NF2 G C

 W !,?6,$S(NBDSECT="":NF2,1:NF1)

C W ?34,$J(NC(1),3),?42,$J(NC(2),3),?50,$J(NC(3),3),?58,$J(NC(4),3),?66,$J(NC(5),3),?74,$J(NCEN,3)

D S NTC(1)=NTC(1)+NC(1),NTC(2)=NTC(2)+NC(2),NTC(3)=NTC(3)+NC(3),NTC(4)=NTC(4)+NC(4),NTC(5)=NTC(5)+NC(5),NTCEN=NTCEN+NCEN,NURMDSW(2)=0

 Q

BRK ; UNIT TOTALS

 G:$G(NURSUMSW) E

 I $Y>(IOSL-6) D HEADER Q:NUROUT  D HEADER1

 W !,?34,"---     ---     ---     ---     ---     ---",!,$S(+NHOSPSW:"SUBTOTAL ",1:"TOTAL"),?34,$J(NTC(1),3),?42,$J(NTC(2),3),?50,$J(NTC(3),3),?58,$J(NTC(4),3),?66,$J(NTC(5),3),?74,$J(NTCEN,3),!

E S DTC(1)=DTC(1)+NTC(1),DTC(2)=DTC(2)+NTC(2),DTC(3)=DTC(3)+NTC(3),DTC(4)=DTC(4)+NTC(4),DTC(5)=DTC(5)+NTC(5),DTCEN=DTCEN+NTCEN

 S NFTC(1)=NFTC(1)+NTC(1),NFTC(2)=NFTC(2)+NTC(2),NFTC(3)=NFTC(3)+NTC(3),NFTC(4)=NFTC(4)+NTC(4),NFTC(5)=NFTC(5)+NTC(5),NFTCEN=NFTCEN+NTCEN

 S NFC(1)=NFC(1)+NTC(1),NFC(2)=NFC(2)+NTC(2),NFC(3)=NFC(3)+NTC(3),NFC(4)=NFC(4)+NTC(4),NFC(5)=NFC(5)+NTC(5),NFCEN=NFCEN+NTCEN

 S NURMDSW(2)=1,(NTC(1),NTC(2),NTC(3),NTC(4),NTC(5),NTCEN)=0

 Q

BRK1 ; DATE TOTALS

 I $Y>(IOSL-6) D HEADER Q:NUROUT  D HEADER1

 W !,?34,"---     ---     ---     ---     ---     ---",!,$E(HDATE(1),4,5)_"/"_$E(HDATE(1),6,7)_"/"_$E(HDATE(1),2,3)," TOTAL",?34,$J(DTC(1),3),?42,$J(DTC(2),3),?50,$J(DTC(3),3),?58,$J(DTC(4),3),?66,$J(DTC(5),3),?74,$J(DTCEN,3),!

 S NURMDSW(2)=1,(DTC(1),DTC(2),DTC(3),DTC(4),DTC(5),DTCEN)=0

 Q

BRK2 ; FACILITY TOTALS

 I $Y>(IOSL-6) D HEADER Q:NUROUT  D HEADER1

 W !,?34,"---     ---     ---     ---     ---     ---",!,NURFAC(2)," TOTALS",?33,$J(NFTC(1),4),?41,$J(NFTC(2),4),?49,$J(NFTC(3),4),?57,$J(NFTC(4),4),?65,$J(NFTC(5),4),?73,$J(NFTCEN,4),!

 S NURMDSW(2)=1,(NFTC(1),NFTC(2),NFTC(3),NFTC(4),NFTC(5),NFTCEN)=0

 Q

NURARPC2  ;HIRMFO/MD-CONTINUATION OF DRIVER TO PRINT AMIS 1106 ACUITY REPORTS ;5/9/97

 +1       ;;4.0;NURSING SERVICE;**1**;Apr 25, 1997

 +2        USE IO

           DO PRINTRPT

 +3        QUIT 

HEADER    ; HEADINGS

 +1        IF $EXTRACT(IOST)="C"

               IF 'NURMDSW(1)

                   DO ENDPG^NURSUT1

                   IF NUROUT

                       QUIT 

 +2       SET HDRDT=$SELECT(+NDATED'=$PIECE(NDATED,U,2):"FROM ",1:"")_$EXTRACT(+NDATED,4,5)_"/"_$EXTRACT(+NDATED,6,7)_"/"_$EXTRACT(+NDATED,2,3)_$SELECT(+NDATED'=...

           ... $PIECE(NDATED,U,2):" - "_$EXTRACT($PIECE(NDATED,U,2),4,5)_"/"_$EXTRACT($PIECE(NDATED,U,2),6,7)_"/"_$EXTRACT($PIECE(NDATED,U,2),2,3),1:"")

 +3        IF $DATA(NDATED)

               IF +NDATED?7N

                   IF '$DATA(NURTYPE)

                       SET NURTYPE=0

                   SET NURSHDR=$SELECT(NURTYPE=0:"AMIS ",1:"Midnight Acuity ")_"Daily Report for "_HDRDT

 +4        SET NURMDSW(1)=0

           SET NURPAGE=NURPAGE+1

           SET Y=DT

           IF +Y

               DO D^DIQ

           IF $EXTRACT(IOST)="C"!(NURPAGE>1)

               WRITE @IOF

 +5        SET NURSHDR(1)="Report 10-1106 Segment 200"

           SET NURSHDR(2)="Cumulative Daily Patient Classification Data"

 +6        IF NURMDSW

               IF NHOSPSW

                   IF $GET(NURFAC(2))'=""

                       IF '$GET(NURSUMSW)

                           WRITE ?$$CNTR^NURSUT2(NURFAC(2)),$SELECT(NURFAC(2)="  BLANK":"NO FACILITY",1:NURFAC(2))

 +7        WRITE !!,Y,?(80-$LENGTH(NURSHDR(1)))\2,NURSHDR(1),?70,"PAGE: ",NURPAGE,!,?(80-$LENGTH(NURSHDR(2)))\2,NURSHDR(2),!,?(80-$LENGTH(NURSHDR))\2,NURSHDR,!

 +8        QUIT 

HEADER1    WRITE !,?72,"PATIENT",!

           IF $GET(HDATE(1))?7N&'($GET(NURSUMSW))

               WRITE "Date: ",$EXTRACT(HDATE(1),4,5)_"/"_$EXTRACT(HDATE(1),6,7)_"/"_$EXTRACT(HDATE(1),2,3)

           WRITE ?22,"CATEGORY      I      II     III      IV       V   CLASS."

 +1        QUIT 

PRINTRPT  ; PRINT REPORT

 +1        SET HDATE(1)=0

           FOR 

               SET HDATE(1)=$ORDER(^TMP($JOB,HDATE(1)))

               IF HDATE(1)'>0

                   QUIT 

               IF 'NURMDSW

                   DO HEADER

               IF NUROUT

                   QUIT 

               IF 'NURMDSW

                   DO HEADER1

               DO L0

               IF NUROUT

                   QUIT 

               IF NHOSPSW

                   DO BRK1

                   IF NUROUT

                       QUIT 

 +2        QUIT 

L0         SET NURFAC(2)=""

           FOR 

               SET NURFAC(2)=$ORDER(^TMP($JOB,HDATE(1),NURFAC(2)))

               IF NURFAC(2)=""

                   QUIT 

               IF NURMDSW&'($GET(NURSUMSW))

                   DO HEADER

               IF NUROUT

                   QUIT 

               IF NURMDSW&'($GET(NURSUMSW))

                   DO HEADER1

               DO L1

               IF NUROUT

                   QUIT 

               IF NHOSPSW

                   IF NURMDSW

                       DO BRK2

                       IF NUROUT

                           QUIT 

 +1        QUIT 

L1         SET NF1=""

           FOR 

               SET NF1=$ORDER(^TMP($JOB,HDATE(1),NURFAC(2),NF1))

               IF NF1=""

                   QUIT 

               DO L2

               IF NUROUT

                   QUIT 

               DO BRK

               IF NUROUT

                   QUIT 

 +1        QUIT 

L2         SET NF2=""

           FOR 

               SET NF2=$ORDER(^TMP($JOB,HDATE(1),NURFAC(2),NF1,NF2))

               IF NF2=""

                   QUIT 

               DO WRITE

               IF NUROUT

                   QUIT 

 +1        QUIT 

WRITE      IF NURMDSW(1)!($Y>(IOSL-6))

               DO HEADER

               IF NUROUT

                   QUIT 

               DO HEADER1

 +1        SET NDATA=^TMP($JOB,HDATE(1),NURFAC(2),NF1,NF2)

 +2        SET NC(1)=+$PIECE(NDATA,U)

           SET NC(2)=+$PIECE(NDATA,U,2)

           SET NC(3)=+$PIECE(NDATA,U,3)

           SET NC(4)=+$PIECE(NDATA,U,4)

           SET NC(5)=+$PIECE(NDATA,U,5)

           SET NCEN=0

           SET NCEN=NCEN+NC(1)+NC(2)+NC(3)+NC(4)+NC(5)

 +3        IF $GET(NURSUMSW)

               GOTO D

 +4        IF NURMDSW(2)

               IF NURSTYPE="U"

                   WRITE !,"WARD: ",$SELECT(NBDSECT="":NF1,1:NF2)

                   GOTO B

 +5        IF NURMDSW(2)

               WRITE !,"BED SECTION: ",NF1

B          IF NURSTYPE="B"

               WRITE !,?6,NF2

               GOTO C

 +1        WRITE !,?6,$SELECT(NBDSECT="":NF2,1:NF1)

C          WRITE ?34,$JUSTIFY(NC(1),3),?42,$JUSTIFY(NC(2),3),?50,$JUSTIFY(NC(3),3),?58,$JUSTIFY(NC(4),3),?66,$JUSTIFY(NC(5),3),?74,$JUSTIFY(NCEN,3)

D          SET NTC(1)=NTC(1)+NC(1)

           SET NTC(2)=NTC(2)+NC(2)

           SET NTC(3)=NTC(3)+NC(3)

           SET NTC(4)=NTC(4)+NC(4)

           SET NTC(5)=NTC(5)+NC(5)

           SET NTCEN=NTCEN+NCEN

           SET NURMDSW(2)=0

 +1        QUIT 

BRK       ; UNIT TOTALS

 +1        IF $GET(NURSUMSW)

               GOTO E

 +2        IF $Y>(IOSL-6)

               DO HEADER

               IF NUROUT

                   QUIT 

               DO HEADER1

 +3        WRITE !,?34,"---     ---     ---     ---     ---     ---",!,$SELECT(+NHOSPSW:"SUBTOTAL ",1:"TOTAL"),?34,$JUSTIFY(NTC(1),3),?42,$JUSTIFY(NTC(2),3),?50,$JUSTIFY(NTC(3),3),?58,$JUSTIFY(NTC(4),3),?66,$JUSTIFY(NTC(5),3),?74,$JUSTIFY(NTCEN,3),!

E          SET DTC(1)=DTC(1)+NTC(1)

           SET DTC(2)=DTC(2)+NTC(2)

           SET DTC(3)=DTC(3)+NTC(3)

           SET DTC(4)=DTC(4)+NTC(4)

           SET DTC(5)=DTC(5)+NTC(5)

           SET DTCEN=DTCEN+NTCEN

 +1        SET NFTC(1)=NFTC(1)+NTC(1)

           SET NFTC(2)=NFTC(2)+NTC(2)

           SET NFTC(3)=NFTC(3)+NTC(3)

           SET NFTC(4)=NFTC(4)+NTC(4)

           SET NFTC(5)=NFTC(5)+NTC(5)

           SET NFTCEN=NFTCEN+NTCEN

 +2        SET NFC(1)=NFC(1)+NTC(1)

           SET NFC(2)=NFC(2)+NTC(2)

           SET NFC(3)=NFC(3)+NTC(3)

           SET NFC(4)=NFC(4)+NTC(4)

           SET NFC(5)=NFC(5)+NTC(5)

           SET NFCEN=NFCEN+NTCEN

 +3        SET NURMDSW(2)=1

           SET (NTC(1),NTC(2),NTC(3),NTC(4),NTC(5),NTCEN)=0

 +4        QUIT 

BRK1      ; DATE TOTALS

 +1        IF $Y>(IOSL-6)

               DO HEADER

               IF NUROUT

                   QUIT 

               DO HEADER1

 +2       WRITE !,?34,"---     ---     ---     ---     ---     ---",!,$EXTRACT(HDATE(1),4,5)_"/"_$EXTRACT(HDATE(1),6,7)_"/"_$EXTRACT(HDATE(1),2,3)," TOTAL",?34,$JUSTIFY(DTC(1),3),?42,...

           ... $JUSTIFY(DTC(2),3),?50,$JUSTIFY(DTC(3),3),?58,$JUSTIFY(DTC(4),3),?66,$JUSTIFY(DTC(5),3),?74,$JUSTIFY(DTCEN,3),!

 +3        SET NURMDSW(2)=1

           SET (DTC(1),DTC(2),DTC(3),DTC(4),DTC(5),DTCEN)=0

 +4        QUIT 

BRK2      ; FACILITY TOTALS

 +1        IF $Y>(IOSL-6)

               DO HEADER

               IF NUROUT

                   QUIT 

               DO HEADER1

 +2        WRITE !,?34,"---     ---     ---     ---     ---     ---",!,NURFAC(2)," TOTALS",?33,$JUSTIFY(NFTC(1),4),?41,$JUSTIFY(NFTC(2),4),?49,$JUSTIFY(NFTC(3),4),?57,$JUSTIFY(NFTC(4),4),?65,$JUSTIFY(NFTC(5),4),?73,$JUSTIFY(NFTCEN,4),!

 +3        SET NURMDSW(2)=1

           SET (NFTC(1),NFTC(2),NFTC(3),NFTC(4),NFTC(5),NFTCEN)=0

 +4        QUIT