- 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 ;