| [613] | 1 | NURSACEN ;HIRMFO/RM,FT-PATIENT CENSUS CALCULATION ;4/30/96 15:42
|
|---|
| 2 | ;;4.0;NURSING SERVICE;;Apr 25, 1997;
|
|---|
| 3 | CALC ; CALCULATE PATIENT CENSUS FOR NURCENDT=DATE/TIME OF CENSUS
|
|---|
| 4 | ; NURCUTDT=$S(D/T FOR CUTOFF TXFR DATE OR 0 FOR NO CUTOFF)
|
|---|
| 5 | ; RETURNS ^TMP($J,"NURCEN",NLOC,DFN)=""
|
|---|
| 6 | N DFN,NURSADM,NURSDT,NURSI,NURSWD,NLOC,VAIN
|
|---|
| 7 | K ^TMP($J,"NURCEN"),^TMP($J,"NURDFN")
|
|---|
| 8 | S NURSWD="" F NURSI=0:0 S NURSWD=$O(^DPT("CN",NURSWD)) Q:NURSWD="" F DFN=0:0 S DFN=$O(^DPT("CN",NURSWD,DFN)) Q:DFN'>0 W:$E(IOST)="C" "." D IFADM
|
|---|
| 9 | F NURSDT(0)=(NURCENDT-.0000001):0 S NURSDT(0)=$O(^DGPM("AMV3",NURSDT(0))) Q:NURSDT(0)'>0 F DFN=0:0 S DFN=$O(^DGPM("AMV3",NURSDT(0),DFN)) Q:DFN'>0 W:$E(IOST)="C" "." D IFDIS
|
|---|
| 10 | K ^TMP($J,"NURDFN") D KVAR^VADPT
|
|---|
| 11 | Q
|
|---|
| 12 | IFADM ; CHECK TO SEE IF AN ADMISSION EXISTS FROM NURCENDT< ADMISSION < NOW
|
|---|
| 13 | S NURSDT=0 D CALCADM I NURSADM F NURSDT=$P(NURSADM,"^",2):0 S NURSDT=$O(^DGPM("ATID3",DFN,NURSDT)) Q:NURSDT'>0!(NURSDT>(9999999-NURCENDT)) S NURSADM=0
|
|---|
| 14 | I 'NURSADM D STUTL
|
|---|
| 15 | Q
|
|---|
| 16 | IFDIS ; CHECK TO SEE IF A DISCHARGE EXISTS BETWEEN CENSUS DATE AND NOW
|
|---|
| 17 | I '$D(^TMP($J,"NURDFN",DFN)) S NURSDT=9999999-NURSDT(0) D CALCADM S ^TMP($J,"NURDFN",DFN)="" I 'NURSADM D STUTL
|
|---|
| 18 | Q
|
|---|
| 19 | CALCADM ;
|
|---|
| 20 | S NURSADM=0 F NURSDT=NURSDT:0 S NURSDT=$O(^DGPM("ATID1",DFN,NURSDT)) Q:NURSDT'>0!(NURSDT>(9999999-NURCENDT)) S NURSADM=$O(^DGPM("ATID1",DFN,NURSDT,0))_"^"_NURSDT
|
|---|
| 21 | Q
|
|---|
| 22 | STUTL ; SETS NLOC=NURSING LOCATION CORR. TO PT. LOC. AT NURCENDT.
|
|---|
| 23 | W:$D(NURSMAN) "." S VAINDT=NURCENDT D NLOC Q:'NLOC
|
|---|
| 24 | I $G(NURCUTDT) D IFTXFR Q:'NLOC
|
|---|
| 25 | S ^TMP($J,"NURCEN",NLOC,DFN)=""
|
|---|
| 26 | Q
|
|---|
| 27 | NLOC ; GET NURSING LOCATION
|
|---|
| 28 | D INP^VADPT
|
|---|
| 29 | I 'VAIN(6) S NLOC=0 Q
|
|---|
| 30 | F NLOC=0:0 S NLOC=$O(^NURSF(211.4,"C",+VAIN(4),NLOC)) Q:$S(NLOC'>0:1,'$D(^NURSF(211.4,NLOC,1)):0,$P(^(1),U)="A":1,1:0)
|
|---|
| 31 | Q
|
|---|
| 32 | IFTXFR ; FIND IF PATIENT TRANSFERRED TO DIFFERENT NURSING LOCATION BETWEEN
|
|---|
| 33 | ; A CERTAIN CUTOFF DATE AND NURCENDT
|
|---|
| 34 | S NLOC(0)=NLOC
|
|---|
| 35 | F NDATE=(9999999-NURCENDT):0 S NDATE=$O(^DGPM("ATID2",DFN,NDATE)) Q:(NDATE<(9999999-NURCUTDT))!(NDATE'>0) S VAINDT=NURCUTDT D NLOC Q
|
|---|
| 36 | S:'NLOC NLOC=NLOC(0)
|
|---|
| 37 | Q
|
|---|
