| 1 | NURARPC4 ;HIRMFO/MD-CONTINUATION OF DRIVER TO PRINT AMIS 1106 PATIENT CATEGORY TOTAL ;5/9/97
|
|---|
| 2 | ;;4.0;NURSING SERVICE;**1**;Apr 25, 1997
|
|---|
| 3 | PERSORT ; TOTAL SUBROUTINE FOR MONTHLY QUARTERLY AND YEARLY CATEGORY TOTALS
|
|---|
| 4 | Q:+$$NOVALU^NURARPC1(NDA)'>0
|
|---|
| 5 | I NURTYPE=0,'($E($P(^NURSA(213.4,NDA,0),U),8)="D") Q
|
|---|
| 6 | I NURTYPE=1,'($E($P(^NURSA(213.4,NDA,0),U),8)="E") Q
|
|---|
| 7 | S YY("W")=$E($P(^NURSA(213.4,NDA,0),U),9,99) I 'NURMDSW!'(NHOSPSW) S NURFAC(2)=" BLANK"
|
|---|
| 8 | I NHOSPSW,$G(NURFAC(2))'=" BLANK" S NURFAC(2)=$$EN12^NURSUT3($G(YY("W"))) Q:$G(NURFAC(2))=""
|
|---|
| 9 | I NHOSPSW,$G(NURFAC(1))'="" Q:$G(NURFAC(1))'=$G(NURFAC(2))
|
|---|
| 10 | K NBED F D1=0:0 S D1=$O(^NURSA(213.4,NDA,1,D1)) Q:D1'>0 I $D(^NURSA(213.4,NDA,1,D1,0)) S YY("B")=$P(^(0),U) D A
|
|---|
| 11 | Q
|
|---|
| 12 | A I NHOSPSW,NURSTYPE="U" S NPWARD=YY("W") D EN6^NURSAUTL S F1=$S(NPWARD="":" BLANK",1:NPWARD),F2=$S(YY("B")="":" BLANK",$D(^NURSF(213.3,YY("B"),0)):$P(^(0),U),1:" BLANK") G SET
|
|---|
| 13 | I NHOSPSW,(YY("B")=NBDSECT!'NBDSECT) S NPWARD=YY("W") D EN6^NURSAUTL S F1=$S(YY("B")="":" BLANK",$D(^NURSF(213.3,YY("B"),0)):$P(^(0),U),1:" BLANK"),F2=$S(NPWARD="":" BLANK",1:NPWARD) G SET
|
|---|
| 14 | I 'NHOSPSW,'NBDSECT,YY("W")=NURSWARD S F1=$S(NURSWARD(0)="":" BLANK",1:NURSWARD(0)),F2=$S(YY("B")="":" BLANK",$D(^NURSF(213.3,YY("B"),0)):$P(^(0),U),1:" BLANK") G SET
|
|---|
| 15 | I 'NHOSPSW,YY("B")=NBDSECT,YY("W")=NURSWARD S F1=$S(YY("B")="":"",$D(^NURSF(213.3,YY("B"),0)):$P(^(0),U),1:" BLANK"),F2=$S(NURSWARD(0)="":" BLANK",1:NURSWARD(0)) G SET
|
|---|
| 16 | E Q
|
|---|
| 17 | SET ; ACCUMULATE PERIOD TOTALS IN TMP GLOBAL
|
|---|
| 18 | S NBED(D1)=$S($D(^NURSA(213.4,NDA,1,D1,0)):^(0),1:"") Q:NBED(D1)="" S NBED("BEDSEC")=$S($P($G(^NURSF(213.3,+NBED(D1),0)),U)'="":$P(^(0),U),1:" BLANK")_U_$P(NBED(D1),U,2,6)
|
|---|
| 19 | I NURMDSW,NHOSPSW,+$G(NURFAC),$P($G(NBED("BEDSEC")),U)'="" D
|
|---|
| 20 | . S:'$D(^TMP("NURBDSM",$J,$P(NBED("BEDSEC"),U))) ^($P(NBED("BEDSEC"),U))="0^0^0^0^0"
|
|---|
| 21 | . F Z=1:1:5 S $P(^TMP("NURBDSM",$J,$P(NBED("BEDSEC"),U)),U,Z)=($P(^($P(NBED("BEDSEC"),U)),U,Z)+$J($P(NBED("BEDSEC"),U,(Z+1)),0,2))
|
|---|
| 22 | . Q
|
|---|
| 23 | I '$D(^TMP($J,NURFAC(2),F1,F2)) S ^TMP($J,NURFAC(2),F1,F2)="0^0^0^0^0"
|
|---|
| 24 | F Y=1:1:5 S $P(^TMP($J,NURFAC(2),F1,F2),U,Y)=$P(^(F2),U,Y)+$J($P(NBED(D1),U,(Y+1)),0,2)
|
|---|
| 25 | Q
|
|---|
| 26 | PERRPT ; PERIOD REPORT
|
|---|
| 27 | S CATL("CEN")=0
|
|---|
| 28 | S NURFAC(2)="" F S NURFAC(2)=$O(^TMP($J,NURFAC(2))) Q:NURFAC(2)="" D:'$G(NURMDSW(1))&'($G(NURSUMSW)) HEADER^NURARPC2 Q:NUROUT D P0 Q:NUROUT D:NHOSPSW&(NURMDSW) BRK2^NURARPC2
|
|---|
| 29 | Q
|
|---|
| 30 | P0 S NF1="" F S NF1=$O(^TMP($J,NURFAC(2),NF1)) Q:NF1="" D P1 Q:NUROUT S NURMDSW(2)=1 D BRK^NURARPC2
|
|---|
| 31 | F X=1:1:5 S NTC(X)=0
|
|---|
| 32 | Q
|
|---|
| 33 | P1 S NF2="" F S NF2=$O(^TMP($J,NURFAC(2),NF1,NF2)) Q:NF2="" D WRITE Q:NUROUT
|
|---|
| 34 | Q
|
|---|
| 35 | WRITE ;
|
|---|
| 36 | I ($Y>(IOSL-4))!(NURMDSW(1)) D HEADER^NURARPC2 Q:NUROUT D HEADER1^NURARPC2
|
|---|
| 37 | S CATL=^TMP($J,NURFAC(2),NF1,NF2)
|
|---|
| 38 | F X=1:1:5 S CATL("CEN")=CATL("CEN")+$P(CATL,U,X)
|
|---|
| 39 | S NTCEN=NTCEN+CATL("CEN")
|
|---|
| 40 | G:$G(NURSUMSW) E
|
|---|
| 41 | I NURMDSW(2),NURSTYPE="U" W !,"WARD: ",$S(NBDSECT="":NF1,1:NF2) G B
|
|---|
| 42 | I NURMDSW(2) W !,"BED SECTION: ",NF1
|
|---|
| 43 | B I NURSTYPE="B" W !,?6,NF2 G C
|
|---|
| 44 | W !,?6,$S(NBDSECT="":NF2,1:NF1)
|
|---|
| 45 | C W ?34,$J($P(CATL,U),3),?42,$J($P(CATL,U,2),3),?50,$J($P(CATL,U,3),3),?58,$J($P(CATL,U,4),3),?66,$J($P(CATL,U,5),3),?74,$J(CATL("CEN"),3)
|
|---|
| 46 | E F X=1:1:5 S NTC(X)=NTC(X)+$P(CATL,U,X)
|
|---|
| 47 | S (NURMDSW(1),CATL("CEN"),NURMDSW(2))=0
|
|---|
| 48 | Q
|
|---|
