- 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)),"^")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCRL2 1980 printed Mar 13, 2025@21:25:54 Page 2
- 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)),"^")
