source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURSACE0.m@ 811

Last change on this file since 811 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1NURSACE0 ;HIRMFO/RM-PT. CENSUS FOR CARE PLANS ;6/24/92
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3CENSUS(BGT,EDT,RDT,SRT) ;
4 ; GIVEN BGT AS BEGINNING DATE FOR CENSUS, AND EDT AS ENDING DATE
5 ; FOR CENSUS, RDT AS THE CURRENT DATE/TIME, AND SRT AS TO WHETHER
6 ; THE DATA WILL BE BY ADMITTING LOC, OR ANY LOCATION PT WAS ON
7 ; DURING THE LENGHT OF STAY, THIS ENTRY WILL CALCULATE THE CENSUS
8 ; AND STORE IN ^TMP($J,"NURCEN",DFN,DGPM)
9 ; GIVEN ARRAY NURSMAS(MASLOC) TO SCREEN OUT PARTICULAR LOCS.
10 N DFN,DGCOR,DGMAS,DGPM,DSDT,MASW K ^TMP($J,"NURCEN")
11 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
12 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
13 Q ''$O(^TMP($J,"NURCEN",0))
14 ;
15CHSTCEN ; CHECK TO SEE IF PATIENT IN HOSPITAL, AND IF IS PUT IN CENSUS
16 S DGCOR=$$CORRADM(DGPM),DGMAS=$$MASW(DGCOR),DGMAS=$S($L(DGMAS):DGMAS,1:$G(MASW)) Q:'$L(DGMAS)
17 I SRT=1,$$MDATE(DGCOR)<EDT,$D(NURSMAS(DGMAS)) S ^TMP($J,"NURCEN",DFN,DGPM)=""
18 I SRT=2 D
19 . N MVDT,DGMPM,DGNPM,NXDT
20 . 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
21 . . S DGMAS=$$MASW(DGMPM) Q:'$L(DGMAS)
22 . . I $$MDATE(DGMPM)<EDT,DGNPM'>0!($$MDATE(DGNPM)>BGT),$D(NURSMAS($$MASW(DGMPM))) S ^TMP($J,"NURCEN",DFN,DGMPM)=""
23 . . S DGNPM=DGMPM
24 . . Q
25 . Q
26 Q
27MDATE(DGPM) ; GET MOVEMENT DATE FOR MOVEMENT DGPM
28 Q +$G(^DGPM(+DGPM,0))
29TTYP(DGPM) ; GET TRANSFER TYPE FOR MOVEMENT DGPM
30 Q +$P($G(^DGPM(+DGPM,0)),"^",2)
31CORRADM(DGPM) ; GET CORRESPONDING ADMISSION FOR MOVEMENT DGPM
32 Q +$P($G(^DGPM(+DGPM,0)),"^",14)
33MASW(DGPM) ; GET FREE TEXT MAS WARD FOR MOVEMENT DGPM
34 Q $P($G(^DIC(42,+$P($G(^DGPM(+DGPM,0)),"^",6),0)),"^")
Note: See TracBrowser for help on using the repository browser.