PXRRPCE2 ;HIN/MjK - Clinic Specfic Workload Reports ;6/7/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**47**;Aug 12, 1996
;P = Appointment Date ; N = Patient Name
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
. S ^TMP($J,"PATIENT",$O(^DPT("SSN",PXRRSSN,"")))="",PXRRTVS=PXRRTVS+1
Q:'$D(^TMP($J,"PATIENT"))
ADM ;_._._._._._._._._._.Admission/Discharge Data_._._._._._._._._._.
;A=search begin date ;B=search end date ;C=admission date
;F=discharge date ;R=room-bed
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
. 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
.. 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)
Q ;_._._._._._._._._._._._.Return to PXRRPCE_._._._._._._._._._._.
Q
LAB ;_._._._._._._._._._._._.Critical Lab Data_._._._._._._._._._._.
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
. 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
.. 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),"*")
ER ;_._._._._._._._._._._._._._ER Visits_._._._._._._._._._._._._._
; **Site Specific IENS from file 44 for ER Clinics**
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)=""
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
. 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)
Q
FUT ;_._._._._._._._._._._._._._Future Visits_._._._._._._._._._._._._._
;L = Appointment Date
D KVAR^VADPT S (L,X1)=DT,X2=90 D C^%DTC S VASD("T")=X D SDA^VADPT
F PXRRN=1:1:5 I $D(^UTILITY("VASD",$J,PXRRN)) S L=$G(^(PXRRN,"I")) D
. S ^TMP($J,"FUT",DFN,$P(L,U))=$P($G(^UTILITY("VASD",$J,PXRRN,"E")),U,2)
Q
DTADD(X1,X2) ; returns fm date X2 days in future
; X1 = starting date
; X2 = # days to add
;
N X
D C^%DTC
Q X
;
PXRRPCE2 ;HIN/MjK - Clinic Specfic Workload Reports ;6/7/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**47**;Aug 12, 1996
+2 ;P = Appointment Date ; N = Patient Name
+3 SET (PXRRTVS,PXRRTPAT)=0
FOR I=1:1
SET PXRRCLIN=$PIECE($GET(PXRRCLIN(I)),U)
IF PXRRCLIN=""
QUIT
SET P=0
FOR
SET P=$ORDER(^TMP($JOB,1,PXRRCLIN,P))
IF 'P
QUIT
SET N=0
FOR
SET N=$ORDER(^TMP($JOB,1,PXRRCLIN,P,"NM",N))
IF N=""
QUIT
SET PXRRSSN=$ORDER(^(N,""))
Begin DoDot:1
+4 SET ^TMP($JOB,"PATIENT",$ORDER(^DPT("SSN",PXRRSSN,"")))=""
SET PXRRTVS=PXRRTVS+1
End DoDot:1
+5 IF '$DATA(^TMP($JOB,"PATIENT"))
QUIT
ADM ;_._._._._._._._._._.Admission/Discharge Data_._._._._._._._._._.
+1 ;A=search begin date ;B=search end date ;C=admission date
+2 ;F=discharge date ;R=room-bed
+3 SET PXRRDIFF=$$FMDIFF^XLFDT(PXRREDT,PXRRBDT)
SET A=$PIECE(PXRRBDT,".")
SET B=$PIECE(PXRREDT,".")
SET PXRJ=0
FOR
SET PXRJ=$ORDER(^TMP($JOB,"PATIENT",PXRJ))
IF 'PXRJ
QUIT
SET DFN=PXRJ
SET PXRRTPAT=PXRRTPAT+1
Begin DoDot:1
+4 FOR PXR=1:1:PXRRDIFF
SET Y=$SELECT(PXR=1:+A,1:$$DTADD(+A,PXR))
SET VAIP("D")=Y
DO IN5^VADPT
IF (+VAIP(2)=1)!(+VAIP(2)=3)
SET C=+VAIP(3)
SET F=$SELECT(+VAIP(14,1):+VAIP(14,1),1:"Not Disch")
SET R=$SELECT(VAIP(6):$PIECE(VAIP(6),U,2),1:"No Room")
DO ADD^VADPT
Begin DoDot:2
+5 SET ^TMP($JOB,"ADM",DFN,C)=F_U_$PIECE(R,"-")_"-"_$PIECE(R,"-",2)_U_VAPA(1)_U_VAPA(2)_U_VAPA(4)_U_$PIECE(VAPA(5),U,2)_U_VAPA(6)_U_VAPA(8)
End DoDot:2
End DoDot:1
DO LAB
DO ER
DO FUT
Q ;_._._._._._._._._._._._.Return to PXRRPCE_._._._._._._._._._._.
+1 QUIT
LAB ;_._._._._._._._._._._._.Critical Lab Data_._._._._._._._._._._.
+1 SET PXRLRDFN=$GET(^DPT(DFN,"LR"))
IF 'PXRLRDFN
QUIT
SET PXRRG=(9999999.9999999-PXRREDT)
FOR
SET PXRRG=$ORDER(^LR(PXRLRDFN,"CH",PXRRG))
IF 'PXRRG!(PXRRG>(9999999.9999999-PXRRBDT))
QUIT
SET PXRRH=0
Begin DoDot:1
+2 FOR
SET PXRRH=$ORDER(^LR(PXRLRDFN,"CH",PXRRG,PXRRH))
IF 'PXRRH
QUIT
IF $PIECE($GET(^LR(PXRLRDFN,"CH",PXRRG,PXRRH)),U,2)?1A1"*"
DO FIELD^DID(63.04,PXRRH,"","LABEL","PXRR")
DO ADD^VADPT
Begin DoDot:2
+3 SET ^TMP($JOB,"LAB",DFN,(9999999.9999999-PXRRG),PXRRH)=PXRR("LABEL")_"= "_$PIECE($GET(^LR(PXRLRDFN,"CH",PXRRG,PXRRH)),U)_U_VAPA(1)_U_VAPA(2)_U_VAPA(4)_U_$PIECE(VAPA(5),U,2)_U_VAPA(6)_U_VAPA(8)_U_$PIECE($PIECE(...
... $GET(^LR(PXRLRDFN,"CH",PXRRG,PXRRH)),U,2),"*")
End DoDot:2
End DoDot:1
ER ;_._._._._._._._._._._._._._ER Visits_._._._._._._._._._._._._._
+1 ; **Site Specific IENS from file 44 for ER Clinics**
+2 SET PX=$ORDER(^PX(815,0))
SET Y=0
FOR
SET Y=$ORDER(^PX(815,PX,"RR1",Y))
IF 'Y
QUIT
SET PXRRER=$PIECE(^(Y,0),U)
SET VASD("C",PXRRER)=""
+3 IF $DATA(PXRRER)
SET VASD("F")=PXRRBDT
SET VASD("T")=PXRREDT
DO SDA^VADPT
SET PXRRK=0
FOR
SET PXRRK=$ORDER(^UTILITY("VASD",$JOB,PXRRK))
IF 'PXRRK
QUIT
SET PXRRT=$PIECE(^UTILITY("VASD",$JOB,PXRRK,"I"),U)
DO ADD^VADPT
Begin DoDot:1
+4 SET ^TMP($JOB,"ER",DFN,PXRRT)=VAPA(1)_U_VAPA(2)_U_VAPA(4)_U_$PIECE(VAPA(5),U,2)_U_VAPA(6)_U_VAPA(8)
End DoDot:1
+5 QUIT
FUT ;_._._._._._._._._._._._._._Future Visits_._._._._._._._._._._._._._
+1 ;L = Appointment Date
+2 DO KVAR^VADPT
SET (L,X1)=DT
SET X2=90
DO C^%DTC
SET VASD("T")=X
DO SDA^VADPT
+3 FOR PXRRN=1:1:5
IF $DATA(^UTILITY("VASD",$JOB,PXRRN))
SET L=$GET(^(PXRRN,"I"))
Begin DoDot:1
+4 SET ^TMP($JOB,"FUT",DFN,$PIECE(L,U))=$PIECE($GET(^UTILITY("VASD",$JOB,PXRRN,"E")),U,2)
End DoDot:1
+5 QUIT
DTADD(X1,X2) ; returns fm date X2 days in future
+1 ; X1 = starting date
+2 ; X2 = # days to add
+3 ;
+4 NEW X
+5 DO C^%DTC
+6 QUIT X
+7 ;
