APCHS2B ; IHS/CMI/LAB - PART 2B OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
;;2.0;IHS PCC SUITE;**10,11,15**;MAY 14, 2009;Build 11
;
OUTPT ; ********** OUTPATIENT ENCOUNTERS * 9000010/9000010.07 **********
; <SETUP>
Q:'$D(^AUPNVSIT("AA",APCHSPAT))
S APCHSOVT="ARSCOTE" ; NOTE: THIS CONTROLS TYPES OF VISITS DISPLAYED
X APCHSCKP Q:$D(APCHSQIT) X:'APCHSNPG APCHSBRK
; <DISPLAY>
S APCHSPVD=0
S APCHSPFN=""
S APCHSDCX="",APCHSDPR=""
I $D(^APCHSCTL(APCHSTYP,2)),$P(^(2),U,3)="Y" S APCHSDCX=1
I $D(^APCHSCTL(APCHSTYP,2)),$P(^(2),U,5)=1 S APCHSDPR=1
I 'APCHSDPR,'APCHSDCX S APCHSDCL=23
I APCHSDCX,'APCHSDPR S APCHSDCL=32
I APCHSDCX,APCHSDPR S APCHSDCL=35
I 'APCHSDCX,APCHSDPR S APCHSDCL=28
F APCHSIVD=0:0 S APCHSIVD=$O(^AUPNVSIT("AA",APCHSPAT,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM) D Q:APCHSNDM=0!(APCHSQT)
. S APCHSQT=1
. D ONEDATE
. Q:$D(APCHSQIT)
. S:(APCHSDAT'=APCHSPVD)&APCHSDTU APCHSNDM=APCHSNDM-APCHSDTU,APCHSPVD=APCHSDAT
. S APCHSQT=0
. Q
;
OUTPTX ; <CLEANUP>
K APCHSIVD,APCHSDTU,APCHSDAT,APCHSVDF,APCHSFAC,APCHSPFN,APCHSSCL,APCHSMTX,APCHSMOD,APCHSPVD,APCHSOVT,APCHSNDT,APCHSCLI,APCHSPDN,APCHSICD,APCHSICL,APCHSNRQ,APCHSDPR,APCHSDCX
K APCHSNFL,APCHSNSH,APCHSCCL,APCHSNAB,APCHSVSC,APCHSITE,APCHSQT,APCHSDCL,Y,APCHCSVD
Q
;
ONEDATE ;
S APCHSCCL=""
S (Y,APCHCSVD)=-APCHSIVD\1+9999999 X APCHSCVD S APCHSDAT=Y
;S (APCHSPFN,APCHSSCL)="",APCHSDTU=0,APCHSNDT=(APCHSDAT'=APCHSPVD)
S APCHSDTU=0,APCHSNDT=(APCHSDAT'=APCHSPVD)
S APCHSVDF="" F APCHSQ=0:0 S APCHSVDF=$O(^AUPNVSIT("AA",APCHSPAT,APCHSIVD,APCHSVDF)) Q:APCHSVDF="" D Q:APCHSQT
. S APCHSQT=1
. S APCHSSCL=""
. S APCHSN=^AUPNVSIT(APCHSVDF,0)
. I $P(APCHSN,U,7)="E",'$D(^AUPNVPOV("AD",APCHSVDF)) S APCHSQT=0 Q ;don't display events with no pov
. I $P(APCHSN,U,7)="I",'$D(^AUPNVPOV("AD",APCHSVDF)) S APCHSQT=0 Q ;don't display in hosp visits with no pov
. I +$P(APCHSN,U,9),'$P(APCHSN,U,11) D GETCLN,GETPROV,GETSITEV^APCHSUTL D
.. I APCHSOVT[APCHSVSC D DSPVIS
.. Q
. Q:$D(APCHSQIT)
. S APCHSQT=0
. Q
Q
;
GETPROV ;
S APCHSPRV=$$PRIMPROV^APCLV(APCHSVDF,"T")
Q
GETCLN ;
S APCHSCLI=$P(APCHSN,U,8) I APCHSCLI="" S APCHSCCL="<none>" Q
S APCHSCLI=$P(APCHSN,U,8) Q:APCHSCLI=""
Q:'$D(^DIC(40.7,APCHSCLI))
I $D(^DIC(40.7,APCHSCLI,9999999)),$P(^(9999999),U,1)]"" S APCHSCLI=$E($P(^DIC(40.7,APCHSCLI,9999999),U,1),1,6),APCHSCCL=APCHSCLI Q
S APCHSCLI=$E($P(^DIC(40.7,APCHSCLI,0),U,1),1,8)
S APCHSCCL=APCHSCLI
Q
DSPVIS ;
S APCHSDTU=1
I $O(^AUPNVPOV("AD",APCHSVDF,""))="" D NOPOV Q
S APCHSPDN="" F APCHSQ=0:0 S APCHSPDN=$O(^AUPNVPOV("AD",APCHSVDF,APCHSPDN)) Q:'APCHSPDN S APCHSN=^AUPNVPOV(APCHSPDN,0) D HASPOV
Q
;
NOPOV ;
S (APCHSICD,APCHSNRQ)="<purpose of visit not yet entered>",APCHSMOD=""
G COMMON
;
HASPOV ;
S APCHCSVD=$$VD^APCLV(APCHSVDF)
S APCHSICD=$P(APCHSN,U,1) D GETICDDX^APCHSUTL
S APCHSNRQ=$P(APCHSN,U,4) D
.I $$WANTPN^APCHSUTL(APCHSTYP) S APCHSNRQ=$$GET1^DIQ(9000010.07,APCHSPDN_",",.04)
.I $P(APCHSN,U,29)]"" S APCHSNRQ=APCHSNRQ_" ["_$$VAL^XBDIQ1(9000010.07,APCHSPDN,.29)_"]" ;IHS/CMI/LAB V2.0 PATCH 15
.I $P(APCHSN,U,5)]"" S APCHSNRQ=APCHSNRQ_" (Stage: "_$P(APCHSN,U,5)_")" ;IHS/CMI/LAB - patched to display stage of 0
S APCHSMOD=$P(APCHSN,U,6)
COMMON ;
X APCHSCKP Q:$D(APCHSQIT) S:APCHSNPG APCHSNDT=1
I APCHSNDT W APCHSDAT S (APCHSPFN,APCHSSCL)="",APCHSNDT=0
I APCHSNSH=APCHSPFN S APCHSFAC=""
E S (APCHSFAC,APCHSPFN)=APCHSNSH,APCHSSCL=""
I APCHSCCL=APCHSSCL S APCHSCLI=""
E S (APCHSCLI,APCHSSCL)=APCHSCCL
I APCHSICD["<purpose of visit not"&(APCHSSCL="<none>") S APCHSCLI=""
I APCHSMOD]"" S APCHSMTX=$P(^DD(9000010.07,.06,0),U,3),APCHSMTX=$P($P(APCHSMTX,APCHSMOD_":",2),";",1),APCHSMTX=$P(APCHSMTX,",",1),APCHSICD=APCHSMTX_" "_APCHSICD
S:$D(^AUPNVCHS("AD",APCHSVDF)) APCHSNTE="*** CHS ***"
;S APCHSICL=$S(APCHSCLI'=" ":35,1:23)
W ?10,APCHSFAC
I APCHSDCX,APCHSDPR W ?23,$E(APCHSCLI,1,6),?30,APCHSPRV
I APCHSDCX,'APCHSDPR W ?23,APCHSCLI
I 'APCHSDCX,APCHSDPR W ?23,APCHSPRV
S APCHSICL=APCHSDCL
S:0 APCHSICD=APCHSVSC_":"_APCHSICD D PRTICD^APCHSUTL
Q
INHOSP ; ********** INHOSPITAL ENCOUNTERS * 9000010/9000010.07 **********
; <SETUP>
Q:'$D(^AUPNVSIT("AA",APCHSPAT))
S APCHSOVT="I" ; NOTE: This controls types of visits displayed
X APCHSCKP Q:$D(APCHSQIT) X:'APCHSNPG APCHSBRK
; <DISPLAY>
S APCHSDCX="",APCHSDPR=""
I $D(^APCHSCTL(APCHSTYP,2)),$P(^(2),U,3)="Y" S APCHSDCX=1
I $D(^APCHSCTL(APCHSTYP,2)),$P(^(2),U,5)=1 S APCHSDPR=1
I 'APCHSDPR,'APCHSDCX S APCHSDCL=23
I APCHSDCX,'APCHSDPR S APCHSDCL=32
I APCHSDCX,APCHSDPR S APCHSDCL=35
I 'APCHSDCX,APCHSDPR S APCHSDCL=28
S APCHSPVD=0
F APCHSIVD=0:0 S APCHSIVD=$O(^AUPNVSIT("AA",APCHSPAT,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM) D ONEDATE Q:$D(APCHSQIT) S:(APCHSDAT'=APCHSPVD)&APCHSDTU APCHSNDM=APCHSNDM-APCHSDTU,APCHSPVD=APCHSDAT Q:APCHSNDM=0
; <CLEANUP>
INHOSPX K APCHSIVD,APCHSDTU,APCHSDAT,APCHSVDF,APCHSFAC,APCHSPFN,APCHSSCL,APCHSMTX,APCHSMOD,APCHSPVD,APCHSOVT,APCHSNDT,APCHSCLI,APCHSPDN,APCHSICD,APCHSICL,APCHSNRQ
K APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE,Y
Q
;
APCHS2B ; IHS/CMI/LAB - PART 2B OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
+1 ;;2.0;IHS PCC SUITE;**10,11,15**;MAY 14, 2009;Build 11
+2 ;
OUTPT ; ********** OUTPATIENT ENCOUNTERS * 9000010/9000010.07 **********
+1 ; <SETUP>
+2 IF '$DATA(^AUPNVSIT("AA",APCHSPAT))
QUIT
+3 ; NOTE: THIS CONTROLS TYPES OF VISITS DISPLAYED
SET APCHSOVT="ARSCOTE"
+4 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
IF 'APCHSNPG
XECUTE APCHSBRK
+5 ; <DISPLAY>
+6 SET APCHSPVD=0
+7 SET APCHSPFN=""
+8 SET APCHSDCX=""
SET APCHSDPR=""
+9 IF $DATA(^APCHSCTL(APCHSTYP,2))
IF $PIECE(^(2),U,3)="Y"
SET APCHSDCX=1
+10 IF $DATA(^APCHSCTL(APCHSTYP,2))
IF $PIECE(^(2),U,5)=1
SET APCHSDPR=1
+11 IF 'APCHSDPR
IF 'APCHSDCX
SET APCHSDCL=23
+12 IF APCHSDCX
IF 'APCHSDPR
SET APCHSDCL=32
+13 IF APCHSDCX
IF APCHSDPR
SET APCHSDCL=35
+14 IF 'APCHSDCX
IF APCHSDPR
SET APCHSDCL=28
+15 FOR APCHSIVD=0:0
SET APCHSIVD=$ORDER(^AUPNVSIT("AA",APCHSPAT,APCHSIVD))
IF APCHSIVD=""!(APCHSIVD>APCHSDLM)
QUIT
Begin DoDot:1
+16 SET APCHSQT=1
+17 DO ONEDATE
+18 IF $DATA(APCHSQIT)
QUIT
+19 IF (APCHSDAT'=APCHSPVD)&APCHSDTU
SET APCHSNDM=APCHSNDM-APCHSDTU
SET APCHSPVD=APCHSDAT
+20 SET APCHSQT=0
+21 QUIT
End DoDot:1
IF APCHSNDM=0!(APCHSQT)
QUIT
+22 ;
OUTPTX ; <CLEANUP>
+1 KILL APCHSIVD,APCHSDTU,APCHSDAT,APCHSVDF,APCHSFAC,APCHSPFN,APCHSSCL,APCHSMTX,APCHSMOD,APCHSPVD,APCHSOVT,APCHSNDT,APCHSCLI,APCHSPDN,APCHSICD,APCHSICL,APCHSNRQ,APCHSDPR,APCHSDCX
+2 KILL APCHSNFL,APCHSNSH,APCHSCCL,APCHSNAB,APCHSVSC,APCHSITE,APCHSQT,APCHSDCL,Y,APCHCSVD
+3 QUIT
+4 ;
ONEDATE ;
+1 SET APCHSCCL=""
+2 SET (Y,APCHCSVD)=-APCHSIVD\1+9999999
XECUTE APCHSCVD
SET APCHSDAT=Y
+3 ;S (APCHSPFN,APCHSSCL)="",APCHSDTU=0,APCHSNDT=(APCHSDAT'=APCHSPVD)
+4 SET APCHSDTU=0
SET APCHSNDT=(APCHSDAT'=APCHSPVD)
+5 SET APCHSVDF=""
FOR APCHSQ=0:0
SET APCHSVDF=$ORDER(^AUPNVSIT("AA",APCHSPAT,APCHSIVD,APCHSVDF))
IF APCHSVDF=""
QUIT
Begin DoDot:1
+6 SET APCHSQT=1
+7 SET APCHSSCL=""
+8 SET APCHSN=^AUPNVSIT(APCHSVDF,0)
+9 ;don't display events with no pov
IF $PIECE(APCHSN,U,7)="E"
IF '$DATA(^AUPNVPOV("AD",APCHSVDF))
SET APCHSQT=0
QUIT
+10 ;don't display in hosp visits with no pov
IF $PIECE(APCHSN,U,7)="I"
IF '$DATA(^AUPNVPOV("AD",APCHSVDF))
SET APCHSQT=0
QUIT
+11 IF +$PIECE(APCHSN,U,9)
IF '$PIECE(APCHSN,U,11)
DO GETCLN
DO GETPROV
DO GETSITEV^APCHSUTL
Begin DoDot:2
+12 IF APCHSOVT[APCHSVSC
DO DSPVIS
+13 QUIT
End DoDot:2
+14 IF $DATA(APCHSQIT)
QUIT
+15 SET APCHSQT=0
+16 QUIT
End DoDot:1
IF APCHSQT
QUIT
+17 QUIT
+18 ;
GETPROV ;
+1 SET APCHSPRV=$$PRIMPROV^APCLV(APCHSVDF,"T")
+2 QUIT
GETCLN ;
+1 SET APCHSCLI=$PIECE(APCHSN,U,8)
IF APCHSCLI=""
SET APCHSCCL="<none>"
QUIT
+2 SET APCHSCLI=$PIECE(APCHSN,U,8)
IF APCHSCLI=""
QUIT
+3 IF '$DATA(^DIC(40.7,APCHSCLI))
QUIT
+4 IF $DATA(^DIC(40.7,APCHSCLI,9999999))
IF $PIECE(^(9999999),U,1)]""
SET APCHSCLI=$EXTRACT($PIECE(^DIC(40.7,APCHSCLI,9999999),U,1),1,6)
SET APCHSCCL=APCHSCLI
QUIT
+5 SET APCHSCLI=$EXTRACT($PIECE(^DIC(40.7,APCHSCLI,0),U,1),1,8)
+6 SET APCHSCCL=APCHSCLI
+7 QUIT
DSPVIS ;
+1 SET APCHSDTU=1
+2 IF $ORDER(^AUPNVPOV("AD",APCHSVDF,""))=""
DO NOPOV
QUIT
+3 SET APCHSPDN=""
FOR APCHSQ=0:0
SET APCHSPDN=$ORDER(^AUPNVPOV("AD",APCHSVDF,APCHSPDN))
IF 'APCHSPDN
QUIT
SET APCHSN=^AUPNVPOV(APCHSPDN,0)
DO HASPOV
+4 QUIT
+5 ;
NOPOV ;
+1 SET (APCHSICD,APCHSNRQ)="<purpose of visit not yet entered>"
SET APCHSMOD=""
+2 GOTO COMMON
+3 ;
HASPOV ;
+1 SET APCHCSVD=$$VD^APCLV(APCHSVDF)
+2 SET APCHSICD=$PIECE(APCHSN,U,1)
DO GETICDDX^APCHSUTL
+3 SET APCHSNRQ=$PIECE(APCHSN,U,4)
Begin DoDot:1
+4 IF $$WANTPN^APCHSUTL(APCHSTYP)
SET APCHSNRQ=$$GET1^DIQ(9000010.07,APCHSPDN_",",.04)
+5 ;IHS/CMI/LAB V2.0 PATCH 15
IF $PIECE(APCHSN,U,29)]""
SET APCHSNRQ=APCHSNRQ_" ["_$$VAL^XBDIQ1(9000010.07,APCHSPDN,.29)_"]"
+6 ;IHS/CMI/LAB - patched to display stage of 0
IF $PIECE(APCHSN,U,5)]""
SET APCHSNRQ=APCHSNRQ_" (Stage: "_$PIECE(APCHSN,U,5)_")"
End DoDot:1
+7 SET APCHSMOD=$PIECE(APCHSN,U,6)
COMMON ;
+1 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
IF APCHSNPG
SET APCHSNDT=1
+2 IF APCHSNDT
WRITE APCHSDAT
SET (APCHSPFN,APCHSSCL)=""
SET APCHSNDT=0
+3 IF APCHSNSH=APCHSPFN
SET APCHSFAC=""
+4 IF '$TEST
SET (APCHSFAC,APCHSPFN)=APCHSNSH
SET APCHSSCL=""
+5 IF APCHSCCL=APCHSSCL
SET APCHSCLI=""
+6 IF '$TEST
SET (APCHSCLI,APCHSSCL)=APCHSCCL
+7 IF APCHSICD["<purpose of visit not"&(APCHSSCL="<none>")
SET APCHSCLI=""
+8 IF APCHSMOD]""
SET APCHSMTX=$PIECE(^DD(9000010.07,.06,0),U,3)
SET APCHSMTX=$PIECE($PIECE(APCHSMTX,APCHSMOD_":",2),";",1)
SET APCHSMTX=$PIECE(APCHSMTX,",",1)
SET APCHSICD=APCHSMTX_" "_APCHSICD
+9 IF $DATA(^AUPNVCHS("AD",APCHSVDF))
SET APCHSNTE="*** CHS ***"
+10 ;S APCHSICL=$S(APCHSCLI'=" ":35,1:23)
+11 WRITE ?10,APCHSFAC
+12 IF APCHSDCX
IF APCHSDPR
WRITE ?23,$EXTRACT(APCHSCLI,1,6),?30,APCHSPRV
+13 IF APCHSDCX
IF 'APCHSDPR
WRITE ?23,APCHSCLI
+14 IF 'APCHSDCX
IF APCHSDPR
WRITE ?23,APCHSPRV
+15 SET APCHSICL=APCHSDCL
+16 IF 0
SET APCHSICD=APCHSVSC_":"_APCHSICD
DO PRTICD^APCHSUTL
+17 QUIT
INHOSP ; ********** INHOSPITAL ENCOUNTERS * 9000010/9000010.07 **********
+1 ; <SETUP>
+2 IF '$DATA(^AUPNVSIT("AA",APCHSPAT))
QUIT
+3 ; NOTE: This controls types of visits displayed
SET APCHSOVT="I"
+4 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
IF 'APCHSNPG
XECUTE APCHSBRK
+5 ; <DISPLAY>
+6 SET APCHSDCX=""
SET APCHSDPR=""
+7 IF $DATA(^APCHSCTL(APCHSTYP,2))
IF $PIECE(^(2),U,3)="Y"
SET APCHSDCX=1
+8 IF $DATA(^APCHSCTL(APCHSTYP,2))
IF $PIECE(^(2),U,5)=1
SET APCHSDPR=1
+9 IF 'APCHSDPR
IF 'APCHSDCX
SET APCHSDCL=23
+10 IF APCHSDCX
IF 'APCHSDPR
SET APCHSDCL=32
+11 IF APCHSDCX
IF APCHSDPR
SET APCHSDCL=35
+12 IF 'APCHSDCX
IF APCHSDPR
SET APCHSDCL=28
+13 SET APCHSPVD=0
+14 FOR APCHSIVD=0:0
SET APCHSIVD=$ORDER(^AUPNVSIT("AA",APCHSPAT,APCHSIVD))
IF APCHSIVD=""!(APCHSIVD>APCHSDLM)
QUIT
DO ONEDATE
IF $DATA(APCHSQIT)
QUIT
IF (APCHSDAT'=APCHSPVD)&APCHSDTU
SET APCHSNDM=APCHSNDM-APCHSDTU
SET APCHSPVD=APCHSDAT
IF APCHSNDM=0
QUIT
+15 ; <CLEANUP>
INHOSPX KILL APCHSIVD,APCHSDTU,APCHSDAT,APCHSVDF,APCHSFAC,APCHSPFN,APCHSSCL,APCHSMTX,APCHSMOD,APCHSPVD,APCHSOVT,APCHSNDT,APCHSCLI,APCHSPDN,APCHSICD,APCHSICL,APCHSNRQ
+1 KILL APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE,Y
+2 QUIT
+3 ;
