source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRPCE2.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1PXRRPCE2 ;HIN/MjK - Clinic Specfic Workload Reports ;6/7/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**47**;Aug 12, 1996
3 ;P = Appointment Date ; N = Patient Name
4 S (PXRRTVS,PXRRTPAT)=0 F I=1:1 S PXRRCLIN=$P($G(PXRRCLIN(I)),U) Q:PXRRCLIN="" S P=0 F S P=$O(^TMP($J,1,PXRRCLIN,P)) Q:'P S N=0 F S N=$O(^TMP($J,1,PXRRCLIN,P,"NM",N)) Q:N="" S PXRRSSN=$O(^(N,"")) D
5 . S ^TMP($J,"PATIENT",$O(^DPT("SSN",PXRRSSN,"")))="",PXRRTVS=PXRRTVS+1
6 Q:'$D(^TMP($J,"PATIENT"))
7ADM ;_._._._._._._._._._.Admission/Discharge Data_._._._._._._._._._.
8 ;A=search begin date ;B=search end date ;C=admission date
9 ;F=discharge date ;R=room-bed
10 S PXRRDIFF=$$FMDIFF^XLFDT(PXRREDT,PXRRBDT),A=$P(PXRRBDT,"."),B=$P(PXRREDT,"."),PXRJ=0 F S PXRJ=$O(^TMP($J,"PATIENT",PXRJ)) Q:'PXRJ S DFN=PXRJ,PXRRTPAT=PXRRTPAT+1 D D LAB,ER,FUT
11 . F PXR=1:1:PXRRDIFF S Y=$S(PXR=1:+A,1:$$DTADD(+A,PXR)) S VAIP("D")=Y D IN5^VADPT I (+VAIP(2)=1)!(+VAIP(2)=3) S C=+VAIP(3),F=$S(+VAIP(14,1):+VAIP(14,1),1:"Not Disch"),R=$S(VAIP(6):$P(VAIP(6),U,2),1:"No Room") D ADD^VADPT D
12 .. S ^TMP($J,"ADM",DFN,C)=F_U_$P(R,"-")_"-"_$P(R,"-",2)_U_VAPA(1)_U_VAPA(2)_U_VAPA(4)_U_$P(VAPA(5),U,2)_U_VAPA(6)_U_VAPA(8)
13Q ;_._._._._._._._._._._._.Return to PXRRPCE_._._._._._._._._._._.
14 Q
15LAB ;_._._._._._._._._._._._.Critical Lab Data_._._._._._._._._._._.
16 S PXRLRDFN=$G(^DPT(DFN,"LR")) Q:'PXRLRDFN S PXRRG=(9999999.9999999-PXRREDT) F S PXRRG=$O(^LR(PXRLRDFN,"CH",PXRRG)) Q:'PXRRG!(PXRRG>(9999999.9999999-PXRRBDT)) S PXRRH=0 D
17 . F S PXRRH=$O(^LR(PXRLRDFN,"CH",PXRRG,PXRRH)) Q:'PXRRH I $P($G(^LR(PXRLRDFN,"CH",PXRRG,PXRRH)),U,2)?1A1"*" D FIELD^DID(63.04,PXRRH,"","LABEL","PXRR"),ADD^VADPT D
18 .. S ^TMP($J,"LAB",DFN,(9999999.9999999-PXRRG),PXRRH)=PXRR("LABEL")_"= "_$P($G(^LR(PXRLRDFN,"CH",PXRRG,PXRRH)),U)_U_VAPA(1)_U_VAPA(2)_U_VAPA(4)_U_$P(VAPA(5),U,2)_U_VAPA(6)_U_VAPA(8)_U_$P($P($G(^LR(PXRLRDFN,"CH",PXRRG,PXRRH)),U,2),"*")
19ER ;_._._._._._._._._._._._._._ER Visits_._._._._._._._._._._._._._
20 ; **Site Specific IENS from file 44 for ER Clinics**
21 S PX=$O(^PX(815,0)),Y=0 F S Y=$O(^PX(815,PX,"RR1",Y)) Q:'Y S PXRRER=$P(^(Y,0),U),VASD("C",PXRRER)=""
22 I $D(PXRRER) S VASD("F")=PXRRBDT,VASD("T")=PXRREDT D SDA^VADPT S PXRRK=0 F S PXRRK=$O(^UTILITY("VASD",$J,PXRRK)) Q:'PXRRK S PXRRT=$P(^UTILITY("VASD",$J,PXRRK,"I"),U) D ADD^VADPT D
23 . S ^TMP($J,"ER",DFN,PXRRT)=VAPA(1)_U_VAPA(2)_U_VAPA(4)_U_$P(VAPA(5),U,2)_U_VAPA(6)_U_VAPA(8)
24 Q
25FUT ;_._._._._._._._._._._._._._Future Visits_._._._._._._._._._._._._._
26 ;L = Appointment Date
27 D KVAR^VADPT S (L,X1)=DT,X2=90 D C^%DTC S VASD("T")=X D SDA^VADPT
28 F PXRRN=1:1:5 I $D(^UTILITY("VASD",$J,PXRRN)) S L=$G(^(PXRRN,"I")) D
29 . S ^TMP($J,"FUT",DFN,$P(L,U))=$P($G(^UTILITY("VASD",$J,PXRRN,"E")),U,2)
30 Q
31DTADD(X1,X2) ; returns fm date X2 days in future
32 ; X1 = starting date
33 ; X2 = # days to add
34 ;
35 N X
36 D C^%DTC
37 Q X
38 ;
Note: See TracBrowser for help on using the repository browser.