APCHS2C ; IHS/CMI/LAB - PART 2C OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
;;2.0;IHS PCC SUITE;**10,15**;MAY 14, 2009;Build 11
;
INPT ; ********** HOSPITALIZATION ENCOUNTERS * 9000010/900010.07 **********
; <SETUP>
Q:'$D(^AUPNVSIT("AAH",APCHSPAT))
X APCHSCKP Q:$D(APCHSQIT) X:'APCHSNPG APCHSBRK
; <DISPLAY>
S APCHSPVD=0
S APCHSIVD="" F APCHSQ=0:0 S APCHSIVD=$O(^AUPNVSIT("AAH",APCHSPAT,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM) D ONEDATE Q:$D(APCHSQIT) S:APCHSDAT'=APCHSPVD APCHSNDM=APCHSNDM-1,APCHSPVD=APCHSDAT Q:APCHSNDM=0
; <CLEANUP>
INPTX K APCHSIVD,APCHSDTU,APCHSDAT,APCHSVDF,APCHSFAC,APCHSFO,APCHSMTX,APCHSMOD,APCHSPVD,APCHSHDN,APCHSDDC,APCHSCDN,APCHSICD,APCHSICL,APCHSN,APCHSNRQ,APCHSPDN,APCHSVTP
K APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE,Y,APCHSIVD,APCHCSVD
Q
ONEDATE S (Y,APCHCSVD)=-APCHSIVD\1+9999999 X APCHSCVD S APCHSDAT=Y S APCHSDTU=(APCHSDAT=APCHSPVD)
S APCHSVDF="" F APCHSQ=0:0 S APCHSVDF=$O(^AUPNVSIT("AAH",APCHSPAT,APCHSIVD,APCHSVDF)) Q:APCHSVDF="" S APCHSN=^AUPNVSIT(APCHSVDF,0) D GETSITEV^APCHSUTL D:"H"[APCHSVSC HOSP Q:$D(APCHSQIT)
Q
;
HOSP ;
Q:$P(APCHSN,U,9)=0!($P(APCHSN,U,11)=1)
S APCHSVTP=$P(APCHSN,U,3)
S APCHSDTU=1
S APCHSFAC=APCHSNSH
S APCHSDDC="?"
I APCHSVTP'="C" S APCHSHDN=$O(^AUPNVINP("AD",APCHSVDF,0)) I APCHSHDN S Y=+^AUPNVINP(APCHSHDN,0) X APCHSCVD S APCHSDDC=Y
I APCHSVTP="C" S APCHSCDN=$O(^AUPNVCHS("AD",APCHSVDF,0)) I APCHSCDN S Y=$P(^AUPNVCHS(APCHSCDN,0),U,7) X APCHSCVD S APCHSDDC=Y
X APCHSCKP Q:$D(APCHSQIT) D IHDR
S APCHSPDN="" F APCHSQ=0:0 S APCHSPDN=$O(^AUPNVPOV("AD",APCHSVDF,APCHSPDN)) Q:'APCHSPDN S APCHSN=^AUPNVPOV(APCHSPDN,0) D DSPPOV
W:$X ?33,"<no visit data>",!
Q
;
DSPPOV 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)_")"
S APCHSMOD=$P(APCHSN,U,6)
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 ***"
X APCHSCKP Q:$D(APCHSQIT) D:APCHSNPG IHDR S APCHSICL=33 S:0 APCHSICD=APCHSVSC_":"_APCHSICD D PRTICD^APCHSUTL
Q
;
IHDR W APCHSDAT,"-",APCHSDDC,?18,APCHSFAC
Q
APCHS2C ; IHS/CMI/LAB - PART 2C OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
+1 ;;2.0;IHS PCC SUITE;**10,15**;MAY 14, 2009;Build 11
+2 ;
INPT ; ********** HOSPITALIZATION ENCOUNTERS * 9000010/900010.07 **********
+1 ; <SETUP>
+2 IF '$DATA(^AUPNVSIT("AAH",APCHSPAT))
QUIT
+3 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
IF 'APCHSNPG
XECUTE APCHSBRK
+4 ; <DISPLAY>
+5 SET APCHSPVD=0
+6 SET APCHSIVD=""
FOR APCHSQ=0:0
SET APCHSIVD=$ORDER(^AUPNVSIT("AAH",APCHSPAT,APCHSIVD))
IF APCHSIVD=""!(APCHSIVD>APCHSDLM)
QUIT
DO ONEDATE
IF $DATA(APCHSQIT)
QUIT
IF APCHSDAT'=APCHSPVD
SET APCHSNDM=APCHSNDM-1
SET APCHSPVD=APCHSDAT
IF APCHSNDM=0
QUIT
+7 ; <CLEANUP>
INPTX KILL APCHSIVD,APCHSDTU,APCHSDAT,APCHSVDF,APCHSFAC,APCHSFO,APCHSMTX,APCHSMOD,APCHSPVD,APCHSHDN,APCHSDDC,APCHSCDN,APCHSICD,APCHSICL,APCHSN,APCHSNRQ,APCHSPDN,APCHSVTP
+1 KILL APCHSNFL,APCHSNSH,APCHSNAB,APCHSVSC,APCHSITE,Y,APCHSIVD,APCHCSVD
+2 QUIT
ONEDATE SET (Y,APCHCSVD)=-APCHSIVD\1+9999999
XECUTE APCHSCVD
SET APCHSDAT=Y
SET APCHSDTU=(APCHSDAT=APCHSPVD)
+1 SET APCHSVDF=""
FOR APCHSQ=0:0
SET APCHSVDF=$ORDER(^AUPNVSIT("AAH",APCHSPAT,APCHSIVD,APCHSVDF))
IF APCHSVDF=""
QUIT
SET APCHSN=^AUPNVSIT(APCHSVDF,0)
DO GETSITEV^APCHSUTL
IF "H"[APCHSVSC
DO HOSP
IF $DATA(APCHSQIT)
QUIT
+2 QUIT
+3 ;
HOSP ;
+1 IF $PIECE(APCHSN,U,9)=0!($PIECE(APCHSN,U,11)=1)
QUIT
+2 SET APCHSVTP=$PIECE(APCHSN,U,3)
+3 SET APCHSDTU=1
+4 SET APCHSFAC=APCHSNSH
+5 SET APCHSDDC="?"
+6 IF APCHSVTP'="C"
SET APCHSHDN=$ORDER(^AUPNVINP("AD",APCHSVDF,0))
IF APCHSHDN
SET Y=+^AUPNVINP(APCHSHDN,0)
XECUTE APCHSCVD
SET APCHSDDC=Y
+7 IF APCHSVTP="C"
SET APCHSCDN=$ORDER(^AUPNVCHS("AD",APCHSVDF,0))
IF APCHSCDN
SET Y=$PIECE(^AUPNVCHS(APCHSCDN,0),U,7)
XECUTE APCHSCVD
SET APCHSDDC=Y
+8 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
DO IHDR
+9 SET APCHSPDN=""
FOR APCHSQ=0:0
SET APCHSPDN=$ORDER(^AUPNVPOV("AD",APCHSVDF,APCHSPDN))
IF 'APCHSPDN
QUIT
SET APCHSN=^AUPNVPOV(APCHSPDN,0)
DO DSPPOV
+10 IF $X
WRITE ?33,"<no visit data>",!
+11 QUIT
+12 ;
DSPPOV SET APCHSICD=$PIECE(APCHSN,U,1)
DO GETICDDX^APCHSUTL
+1 SET APCHSNRQ=$PIECE(APCHSN,U,4)
Begin DoDot:1
+2 IF $$WANTPN^APCHSUTL(APCHSTYP)
SET APCHSNRQ=$$GET1^DIQ(9000010.07,APCHSPDN_",",.04)
+3 ;IHS/CMI/LAB V2.0 PATCH 15
IF $PIECE(APCHSN,U,29)]""
SET APCHSNRQ=APCHSNRQ_" ["_$$VAL^XBDIQ1(9000010.07,APCHSPDN,.29)_"]"
+4 IF $PIECE(APCHSN,U,5)]""
SET APCHSNRQ=APCHSNRQ_" (Stage: "_$PIECE(APCHSN,U,5)_")"
End DoDot:1
+5 SET APCHSMOD=$PIECE(APCHSN,U,6)
+6 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
+7 IF $DATA(^AUPNVCHS("AD",APCHSVDF))
SET APCHSNTE="*** CHS ***"
+8 XECUTE APCHSCKP
IF $DATA(APCHSQIT)
QUIT
IF APCHSNPG
DO IHDR
SET APCHSICL=33
IF 0
SET APCHSICD=APCHSVSC_":"_APCHSICD
DO PRTICD^APCHSUTL
+9 QUIT
+10 ;
IHDR WRITE APCHSDAT,"-",APCHSDDC,?18,APCHSFAC
+1 QUIT
