NURCRL2.m

NURCRL2 ;HIRMFO/RM-PT. CENSUS FOR CARE PLANS ;9/10/91

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

 ;;

CENSUS(BGT,EDT,RDT,SRT) ; 

 ; GIVEN BGT AS BEGINNING DATE FOR CENSUS, AND EDT AS ENDING DATE

 ; FOR CENSUS, RDT AS THE CURRENT DATE/TIME, AND SRT AS TO WHETHER

 ; THE DATA WILL BE BY ADMITTING LOC, OR ANY LOCATION PT WAS ON

 ; DURING THE LENGHT OF STAY, THIS ENTRY WILL CALCULATE THE CENSUS

 ; AND STORE IN ^TMP($J,"NURCEN",DFN,DGPM)

 ;   GIVEN ARRAY NURSMAS(MASLOC) TO SCREEN OUT PARTICULAR LOCS.

 N DFN,DGCOR,DGMAS,DGPM,DSDT,MASW K ^TMP($J,"NURCEN")

 F DSDT=BGT:0 S DSDT=$O(^DGPM("AMV3",DSDT)) Q:DSDT'>0!(DSDT>RDT)  F DFN=0:0 S DFN=$O(^DGPM("AMV3",DSDT,DFN)) Q:DFN'>0  F DGPM=0:0 S DGPM=$O(^DGPM("AMV3",DSDT,DFN,DGPM)) Q:DGPM'>0  D CHSTCEN

 S MASW="" F  S MASW=$O(^DGPM("CN",MASW)) Q:MASW=""  F DGPM=0:0 S DGPM=$O(^DGPM("CN",MASW,DGPM)) Q:DGPM'>0  S DFN=$P($G(^DGPM(+DGPM,0)),"^",3) D:DFN>0 CHSTCEN

 Q ''$O(^TMP($J,"NURCEN",0))

CHSTCEN ; CHECK TO SEE IF PATIENT IN HOSPITAL, AND IF IS PUT IN CENSUS

 S DGCOR=$$CORRADM(DGPM),DGMAS=$$MASW(DGCOR),DGMAS=$S($L(DGMAS):DGMAS,1:$G(MASW)) Q:'$L(DGMAS)

 I SRT=1,$$MDATE(DGCOR)<EDT,$D(NURSMAS(DGMAS)) S ^TMP($J,"NURCEN",DFN,DGPM)=""

 I SRT=2 D

 .   N MVDT,DGMPM,DGNPM,NXDT

 .   S (DGNPM,MVDT)=0 F  S MVDT=$O(^DGPM("APMV",DFN,DGCOR,MVDT)) Q:MVDT'>0  S DGMPM=0 F  S DGMPM=$O(^DGPM("APMV",DFN,DGCOR,MVDT,DGMPM)) Q:DGMPM'>0  D:$$TTYP(DGMPM)'=3

 .   .   S DGMAS=$$MASW(DGMPM) Q:'$L(DGMAS)

 .   .   I $$MDATE(DGMPM)<EDT,DGNPM'>0!($$MDATE(DGNPM)>BGT),$D(NURSMAS($$MASW(DGMPM))) S ^TMP($J,"NURCEN",DFN,DGMPM)=""

 .   .   S DGNPM=DGMPM

 .   .   Q

 .   Q

 Q

MDATE(DGPM) ; GET MOVEMENT DATE FOR MOVEMENT DGPM

 Q +$G(^DGPM(+DGPM,0))

TTYP(DGPM) ; GET TRANSFER TYPE FOR MOVEMENT DGPM

 Q +$P($G(^DGPM(+DGPM,0)),"^",2)

CORRADM(DGPM) ; GET CORRESPONDING ADMISSION FOR MOVEMENT DGPM

 Q +$P($G(^DGPM(+DGPM,0)),"^",14)

MASW(DGPM) ; GET FREE TEXT MAS WARD FOR MOVEMENT DGPM

 Q $P($G(^DIC(42,+$P($G(^DGPM(+DGPM,0)),"^",6),0)),"^")

NURCRL2   ;HIRMFO/RM-PT. CENSUS FOR CARE PLANS ;9/10/91

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

 +2       ;;

CENSUS(BGT,EDT,RDT,SRT) ; 

 +1       ; GIVEN BGT AS BEGINNING DATE FOR CENSUS, AND EDT AS ENDING DATE

 +2       ; FOR CENSUS, RDT AS THE CURRENT DATE/TIME, AND SRT AS TO WHETHER

 +3       ; THE DATA WILL BE BY ADMITTING LOC, OR ANY LOCATION PT WAS ON

 +4       ; DURING THE LENGHT OF STAY, THIS ENTRY WILL CALCULATE THE CENSUS

 +5       ; AND STORE IN ^TMP($J,"NURCEN",DFN,DGPM)

 +6       ;   GIVEN ARRAY NURSMAS(MASLOC) TO SCREEN OUT PARTICULAR LOCS.

 +7        NEW DFN,DGCOR,DGMAS,DGPM,DSDT,MASW

           KILL ^TMP($JOB,"NURCEN")

 +8        FOR DSDT=BGT:0

               SET DSDT=$ORDER(^DGPM("AMV3",DSDT))

               IF DSDT'>0!(DSDT>RDT)

                   QUIT 

               FOR DFN=0:0

                   SET DFN=$ORDER(^DGPM("AMV3",DSDT,DFN))

                   IF DFN'>0

                       QUIT 

                   FOR DGPM=0:0

                       SET DGPM=$ORDER(^DGPM("AMV3",DSDT,DFN,DGPM))

                       IF DGPM'>0

                           QUIT 

                       DO CHSTCEN

 +9        SET MASW=""

           FOR 

               SET MASW=$ORDER(^DGPM("CN",MASW))

               IF MASW=""

                   QUIT 

               FOR DGPM=0:0

                   SET DGPM=$ORDER(^DGPM("CN",MASW,DGPM))

                   IF DGPM'>0

                       QUIT 

                   SET DFN=$PIECE($GET(^DGPM(+DGPM,0)),"^",3)

                   IF DFN>0

                       DO CHSTCEN

 +10       QUIT ''$ORDER(^TMP($JOB,"NURCEN",0))

CHSTCEN   ; CHECK TO SEE IF PATIENT IN HOSPITAL, AND IF IS PUT IN CENSUS

 +1        SET DGCOR=$$CORRADM(DGPM)

           SET DGMAS=$$MASW(DGCOR)

           SET DGMAS=$SELECT($LENGTH(DGMAS):DGMAS,1:$GET(MASW))

           IF '$LENGTH(DGMAS)

               QUIT 

 +2        IF SRT=1

               IF $$MDATE(DGCOR)<EDT

                   IF $DATA(NURSMAS(DGMAS))

                       SET ^TMP($JOB,"NURCEN",DFN,DGPM)=""

 +3        IF SRT=2

               Begin DoDot:1

 +4                NEW MVDT,DGMPM,DGNPM,NXDT

 +5                SET (DGNPM,MVDT)=0

                   FOR 

                       SET MVDT=$ORDER(^DGPM("APMV",DFN,DGCOR,MVDT))

                       IF MVDT'>0

                           QUIT 

                       SET DGMPM=0

                       FOR 

                           SET DGMPM=$ORDER(^DGPM("APMV",DFN,DGCOR,MVDT,DGMPM))

                           IF DGMPM'>0

                               QUIT 

                           IF $$TTYP(DGMPM)'=3

                               Begin DoDot:2

 +6                                SET DGMAS=$$MASW(DGMPM)

                                   IF '$LENGTH(DGMAS)

                                       QUIT 

 +7                                IF $$MDATE(DGMPM)<EDT

                                       IF DGNPM'>0!($$MDATE(DGNPM)>BGT)

                                           IF $DATA(NURSMAS($$MASW(DGMPM)))

                                               SET ^TMP($JOB,"NURCEN",DFN,DGMPM)=""

 +8                                SET DGNPM=DGMPM

 +9                                QUIT 

                               End DoDot:2

 +10               QUIT 

               End DoDot:1

 +11       QUIT 

MDATE(DGPM) ; GET MOVEMENT DATE FOR MOVEMENT DGPM

 +1        QUIT +$GET(^DGPM(+DGPM,0))

TTYP(DGPM) ; GET TRANSFER TYPE FOR MOVEMENT DGPM

 +1        QUIT +$PIECE($GET(^DGPM(+DGPM,0)),"^",2)

CORRADM(DGPM) ; GET CORRESPONDING ADMISSION FOR MOVEMENT DGPM

 +1        QUIT +$PIECE($GET(^DGPM(+DGPM,0)),"^",14)

MASW(DGPM) ; GET FREE TEXT MAS WARD FOR MOVEMENT DGPM

 +1        QUIT $PIECE($GET(^DIC(42,+$PIECE($GET(^DGPM(+DGPM,0)),"^",6),0)),"^")