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
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
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURARPC2 3947 printed Dec 13, 2024@02:19:51 Page 2
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
+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
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
