- 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 Feb 18, 2025@23:46:17 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