source: FOIAVistA/trunk/r/GEN_MED_OTHER-GMV/GMVGETD.m

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1GMVGETD ;HOIFO/YH,FT-EXTRACTS WARD/ROOM-BED/PT AND PT VITALS ;5/25/05 16:32
2 ;;5.0;GEN. MED. REC. - VITALS;**3**;Oct 31, 2002
3 ;
4 ; This routine uses the following IAs:
5 ; #1380 - ^DG(405.4 references (controlled)
6 ; #1377 - ^DIC(42 references (controlled)
7 ; #10035 - FILE 2 references (supported)
8 ; #10039 - FILE 42 references (supported)
9 ;
10 ; This routine supports the following IAs:
11 ; #4416 - GMV EXTRACT REC RPC is called at GETVM (private)
12 ; #4358 - GMV LATEST VM RPC is called at GETLAT (private)
13 ;
14GETVM(RESULT,GMRVDATA) ;GMV EXTRACT REC [RPC entry point]
15 ;RETURNS VITALS/MEASUREMENTS FOR A PARTICULAR PATIENT A FOR GIVEN DATE/TIME SPAN IN RESULT ARRAY.
16 ;GMRVDATA = DFN^END DATE VITAL TAKEN^VITAL TYPE (OPTIONAL)^START DATE VITAL TAKEN
17 N GMVDAYS,DFN,GMRVSDT,GMRVFDT,GMVTYPE S DFN=+$P(GMRVDATA,"^"),GMRVSDT=+$P(GMRVDATA,"^",2),GMVDAYS=$P(GMRVDATA,"^",4),GMVTYPE=$P(GMRVDATA,"^",3) K ^TMP($J,"GRPC")
18 S GMRVFDT=$P(GMRVSDT,".",1)_".2400"
19 I GMVDAYS'="" S GMRVSDT=$P(GMVDAYS,".",1)
20 S:GMVTYPE'="" GMVTYPE(1)=$P(^GMRD(120.51,$O(^GMRD(120.51,"C",GMVTYPE,0)),0),"^")
21 D EN1^GMVGETD1
22 I '$D(^TMP($J,"GRPC")) S ^TMP($J,"GRPC",1)="0^NO "_$S(GMVTYPE'="":GMVTYPE(1),1:"VITALS/MEASUREMENTS ")_" ENTERED WITHIN THIS PERIOD"
23 S RESULT=$NA(^TMP($J,"GRPC"))
24 K GMRDT,GMRVARY,GMRVITY,GMRVX,GMRZZ
25 Q
26GETLAT(RESULT,GMRDFN) ;GMV LATEST VM [RPC entry point]
27 ; RETURNS THE LATEST VITALS/MEASUREMENTS FOR A GIVEN PATIENT(GMRDFN)
28 ; IN RESULT ARRAY.
29 K ^TMP($J,"GRPC") D EN1^GMVLAT0(GMRDFN)
30 S RESULT=$NA(^TMP($J,"GRPC"))
31 Q
32WARDLOC(RESULT,DUMMY) ;GMV WARD LOCATION [RPC entry point]
33 ;RETURNS MAS WARD LOCATIONS IN RESULT ARRAY
34 K ^TMP($J,"GWARD"),^TMP($J,"GMRV") N GMRWARD,GINDEX,GN,GMR
35 D LIST^DIC(42,"","","","*","","","","","I '$$INACT42^GMVUT2(+Y)","^TMP($J,""GMRV"")")
36 S GINDEX=+$P($G(^TMP($J,"GMRV","DILIST",0)),"^")
37 I GINDEX>0 D
38 . S (GMR,GN)=0 F S GN=$O(^TMP($J,"GMRV","DILIST",1,GN)) Q:GN'>0 D
39 . . S GMRWARD(1)=^TMP($J,"GMRV","DILIST",1,GN),GMRWARD=+^TMP($J,"GMRV","DILIST",2,GN) I $O(^DPT("CN",GMRWARD(1),0))>0 S GMR=GMR+1,^TMP($J,"GWARD",GMR)=GMRWARD_"^"_GMRWARD(1)_U_^DIC(42,GMRWARD,44)
40 K ^TMP($J,"GMRV") S RESULT=$NA(^TMP($J,"GWARD"))
41 Q
42WARDPT(RESULT,GMRWARD) ;GMV WARD PT [RPC entry point]
43 ;RETURNS A LIST OF PATIENTS ADMITTED TO A GIVEN MAS WARD(GMRWARD) IN RESULT ARRAY.
44 Q:'$D(^DPT("CN",GMRWARD))
45 N OUT,GN,DFN,DFN1,GMVPAT
46 K ^TMP($J,"GMRPT")
47 S (GN,DFN)=0 F S DFN=$O(^DPT("CN",GMRWARD,DFN)) Q:DFN'>0 D
48 . I $D(^DPT(DFN,0)) D
49 . . S GMVPAT=""
50 . . D PTINFO^GMVUTL3(.GMVPAT,DFN)
51 . . S OUT($P(^DPT(DFN,0),"^"),DFN)=DFN_"^"_$P(^DPT(DFN,0),"^")_"^"_GMVPAT
52 I '$D(OUT) Q
53 S DFN=""
54 F S DFN=$O(OUT(DFN)) Q:DFN="" D
55 .S DFN1=0
56 .F S DFN1=$O(OUT(DFN,DFN1)) Q:'DFN1 D
57 ..S GN=GN+1,^TMP($J,"GMRPT",GN)=OUT(DFN,DFN1)
58 ..Q
59 .Q
60 S RESULT=$NA(^TMP($J,"GMRPT"))
61 Q
62ROOMBED(RESULT,GMRWARD) ;GMV ROOM/BED [RPC entry point]
63 ;RETURNS A LIST OF ROOMS/BEDS FOR A GIVEN MAS WARD(GMRWARD) IN RESULT ARRAY.
64 Q:'$D(^DIC(42,"B",GMRWARD))
65 N GN,GROOM,GWARD,GMVTMP K ^TMP($J,"GROOM")
66 S (GN,GROOM)=0,GWARD=$O(^DIC(42,"B",GMRWARD,0)) I GWARD'>0 S ^TMP($J,"GROOM",1)="NO ROOM" G QUIT
67 F S GROOM=$O(^DG(405.4,"W",GWARD,GROOM)) Q:GROOM'>0 I $D(^DG(405.4,GROOM)) D
68 . S GMVTMP($P($P(^DG(405.4,GROOM,0),"^"),"-",1))=GROOM
69 . ;S GN=GN+1,^TMP($J,"GROOM",GN)=GROOM_"^"_$P(^DG(405.4,GROOM,0),"^")
70 . Q
71 S GROOM="",GN=0
72 F S GROOM=$O(GMVTMP(GROOM)) Q:GROOM="" D
73 . S GN=GN+1,^TMP($J,"GROOM",GN)=GMVTMP(GROOM)_"^"_GROOM
74 . Q
75QUIT S RESULT=$NA(^TMP($J,"GROOM"))
76 Q
Note: See TracBrowser for help on using the repository browser.