AMEREDPC ; IHS/OIT/SCR - SUB ROUTINE FOR PCC VISIT CREATION;
;;3.0;ER VISIT SYSTEM;**1,6**;MAR 03, 2009;Build 30
;
CHKVSIT(AMERDA,AMERAIEN) ; EP FROM AMEREDIT to validate and save PCC information
; AMERDA - IEN OF ER VISIT
; AMERAIEN - IEN OF AUDIT RECORD - IF "", NOT IN EDIT MODE
; CHECK for required elements of a PCC Visit
; 1. Primary Provider is in Provider file
; 2. Primary DX and Narrative exist as valid codes/strings
; 3. Valid patient IEN
; 4. Dates make sense and are not in the future
;
N AMERQUIT,APCDTPRO,APCDTNQ,APCTPAT,AMERTIME,APCDTPOV,AMERNAR,AMERPRIM
N AMERDX,AMERDATE,AMERTIME,AMERDSCH,AMERDEPT,AMERERR,AMERPAT,AMERPROV
S AMERQUIT=0,(APCDTPRO,APCDTNQ,APCDTPAT,AMERTIME,APCDTPOV,AMERNAR,AMERDSCH)=""
;Primary provider must hold AK.PROVIDER keys
S AMERPROV=""
I $G(^AMERVSIT(AMERDA,6))'="" S AMERPROV=$P(^AMERVSIT(AMERDA,6),U,3)
I AMERPROV'="" D
.I $D(^VA(200,"AK.PROVIDER",$P($G(^VA(200,AMERPROV,0)),U),AMERPROV)) S APCDTPRO=AMERPROV
.Q
I AMERPROV="" S APCDTPRO=""
; Valid Primary DX AND NARRATIVE
I $P($G(^AMERVSIT(AMERDA,5.1)),U,2)'="" D
.S AMERDX=$P(^AMERVSIT(AMERDA,5.1),U,2),AMERNAR=$P(^AMERVSIT(AMERDA,5.1),U,3)
.;IHS/OIT/SCR 11/20/08 TEMP ALLOWING LOCAL CODES
.;AMER*3*6;Get to work for ICD-10
.NEW ICDINFO,VDATE
.S VDATE=$P($$GET1^DIQ(9009080,AMERDA,.01,"I"),".")
.I $$AICD^AMERUTIL() S ICDINFO=$$ICDDX^ICDEX(+AMERDX,VDATE)
.E S ICDINFO=$$ICDDX^ICDCODE(+AMERDX,VDATE)
.I $P(ICDINFO,U)'=-1,$P(ICDINFO,U,2)'="ZZZ.999",$P(ICDINFO,U,2)'=".9999" S APCDTPOV="`"_AMERDX
.E S APCDTPOV=""
.;valid narrative
.I AMERNAR'="" S APCDTNQ=AMERNAR
.Q
I $P($G(^AMERVSIT(AMERDA,5.1)),U,2)="" S (APCDTNQ,APCDTPOV)=""
;valid patient identifier
I $P($G(^AMERVSIT(AMERDA,0)),U,2)'="" D
.S AMERPAT=$P(^AMERVSIT(AMERDA,0),U,2)
.I $D(^DPT(AMERPAT)) S APCDTPAT=AMERPAT
.Q
;valid date of visit (not in future)
I $G(^AMERVSIT(AMERDA,0))'="" S AMERTIME=$P(^AMERVSIT(AMERDA,0),U,1)
D NOW^%DTC
S X1=%,X2=AMERTIME
D ^%DTC
I X>=0 S AMERDATE=AMERTIME
;valid discharge date (not before admission)
;IHS/OIT/SCR 061809 - avoid undefined if no discharge data is present
;I $G(^AMERVSIT(AMERDA,6))'="" S AMERDEPT=$P(^AMERVSIT(AMERDA,6),U,2)
I $G(^AMERVSIT(AMERDA,6))'="" D
.S AMERDEPT=$P(^AMERVSIT(AMERDA,6),U,2)
.;if ARRIVE TIME compared to DEPART TIME is before
.I $$TCOMP^AMERTIME(AMERTIME,AMERDEPT,0) S AMERDSCH=AMERDEPT
.Q
I $G(^AMERVSIT(AMERDA,6))="" D
.D EN^DDIOL("No DISCHARGE information available for this ERS VISIT^","","!!") ;IHS/OIT/SCR 061809
.S AMERDSCH=0
.Q
;if there is missing information, print each
S AMERERR=$$PCCERROR(APCDTPRO,APCDTNQ,APCDTPOV,APCDTPAT,AMERDATE,AMERDSCH)
I AMERERR'="" D
.S AMERQUIT=1
.D EN^DDIOL("***INSUFFICIENT DATA AVAILABLE FOR COMPLETE PCC VISIT***","","!!")
.D EN^DDIOL("","","!")
.F AMERI=1:1 S AMERWRIT=$P(AMERERR,U,AMERI) Q:AMERWRIT="" D EN^DDIOL($P(AMERERR,U,AMERI),"","!")
.D EN^DDIOL("***PLEASE CORRECT THESE PROBLEMS ***","","!!?10")
.D EN^DDIOL("","","!")
.Q
D SYNCHPCC^AMERPCC(AMERDA) ;even if problems, save what you can
Q:AMERQUIT 0
K AMERQUIT,APCDTPRO,APCDTNQ,APCTPAT,AMERTIME,APCDTPOV,AMERNAR,AMERPRIM
K AMERDX,AMERDATE,AMERTIME,AMERDSCH,AMERDEPT,AMERPAT,AMERPROV
Q 1
PCCERROR(PROVIDER,PRIMNAR,PRIMDIAG,PATIENT,AMERDATE,AMERDSCH) ;
S AMERERR=""
I PROVIDER="" S AMERERR=AMERERR_"Valid discharge provider missing^"
I PRIMNAR="" S AMERERR=AMERERR_"Primary provider narrative missing^"
I PRIMDIAG="" S AMERERR=AMERERR_"primary diagnosis is not coded^"
I PATIENT="" S AMERERR=AMERERR_"Valid patient identifier missing^"
I AMERDATE="" S AMERERR=AMERERR_"Time of visit cannot be in future^"
I AMERDSCH="" S AMERERR=AMERERR_"Discharge time must be after admission time^"
Q AMERERR
AMEREDPC ; IHS/OIT/SCR - SUB ROUTINE FOR PCC VISIT CREATION;
+1 ;;3.0;ER VISIT SYSTEM;**1,6**;MAR 03, 2009;Build 30
+2 ;
CHKVSIT(AMERDA,AMERAIEN) ; EP FROM AMEREDIT to validate and save PCC information
+1 ; AMERDA - IEN OF ER VISIT
+2 ; AMERAIEN - IEN OF AUDIT RECORD - IF "", NOT IN EDIT MODE
+3 ; CHECK for required elements of a PCC Visit
+4 ; 1. Primary Provider is in Provider file
+5 ; 2. Primary DX and Narrative exist as valid codes/strings
+6 ; 3. Valid patient IEN
+7 ; 4. Dates make sense and are not in the future
+8 ;
+9 NEW AMERQUIT,APCDTPRO,APCDTNQ,APCTPAT,AMERTIME,APCDTPOV,AMERNAR,AMERPRIM
+10 NEW AMERDX,AMERDATE,AMERTIME,AMERDSCH,AMERDEPT,AMERERR,AMERPAT,AMERPROV
+11 SET AMERQUIT=0
SET (APCDTPRO,APCDTNQ,APCDTPAT,AMERTIME,APCDTPOV,AMERNAR,AMERDSCH)=""
+12 ;Primary provider must hold AK.PROVIDER keys
+13 SET AMERPROV=""
+14 IF $GET(^AMERVSIT(AMERDA,6))'=""
SET AMERPROV=$PIECE(^AMERVSIT(AMERDA,6),U,3)
+15 IF AMERPROV'=""
Begin DoDot:1
+16 IF $DATA(^VA(200,"AK.PROVIDER",$PIECE($GET(^VA(200,AMERPROV,0)),U),AMERPROV))
SET APCDTPRO=AMERPROV
+17 QUIT
End DoDot:1
+18 IF AMERPROV=""
SET APCDTPRO=""
+19 ; Valid Primary DX AND NARRATIVE
+20 IF $PIECE($GET(^AMERVSIT(AMERDA,5.1)),U,2)'=""
Begin DoDot:1
+21 SET AMERDX=$PIECE(^AMERVSIT(AMERDA,5.1),U,2)
SET AMERNAR=$PIECE(^AMERVSIT(AMERDA,5.1),U,3)
+22 ;IHS/OIT/SCR 11/20/08 TEMP ALLOWING LOCAL CODES
+23 ;AMER*3*6;Get to work for ICD-10
+24 NEW ICDINFO,VDATE
+25 SET VDATE=$PIECE($$GET1^DIQ(9009080,AMERDA,.01,"I"),".")
+26 IF $$AICD^AMERUTIL()
SET ICDINFO=$$ICDDX^ICDEX(+AMERDX,VDATE)
+27 IF '$TEST
SET ICDINFO=$$ICDDX^ICDCODE(+AMERDX,VDATE)
+28 IF $PIECE(ICDINFO,U)'=-1
IF $PIECE(ICDINFO,U,2)'="ZZZ.999"
IF $PIECE(ICDINFO,U,2)'=".9999"
SET APCDTPOV="`"_AMERDX
+29 IF '$TEST
SET APCDTPOV=""
+30 ;valid narrative
+31 IF AMERNAR'=""
SET APCDTNQ=AMERNAR
+32 QUIT
End DoDot:1
+33 IF $PIECE($GET(^AMERVSIT(AMERDA,5.1)),U,2)=""
SET (APCDTNQ,APCDTPOV)=""
+34 ;valid patient identifier
+35 IF $PIECE($GET(^AMERVSIT(AMERDA,0)),U,2)'=""
Begin DoDot:1
+36 SET AMERPAT=$PIECE(^AMERVSIT(AMERDA,0),U,2)
+37 IF $DATA(^DPT(AMERPAT))
SET APCDTPAT=AMERPAT
+38 QUIT
End DoDot:1
+39 ;valid date of visit (not in future)
+40 IF $GET(^AMERVSIT(AMERDA,0))'=""
SET AMERTIME=$PIECE(^AMERVSIT(AMERDA,0),U,1)
+41 DO NOW^%DTC
+42 SET X1=%
SET X2=AMERTIME
+43 DO ^%DTC
+44 IF X>=0
SET AMERDATE=AMERTIME
+45 ;valid discharge date (not before admission)
+46 ;IHS/OIT/SCR 061809 - avoid undefined if no discharge data is present
+47 ;I $G(^AMERVSIT(AMERDA,6))'="" S AMERDEPT=$P(^AMERVSIT(AMERDA,6),U,2)
+48 IF $GET(^AMERVSIT(AMERDA,6))'=""
Begin DoDot:1
+49 SET AMERDEPT=$PIECE(^AMERVSIT(AMERDA,6),U,2)
+50 ;if ARRIVE TIME compared to DEPART TIME is before
+51 IF $$TCOMP^AMERTIME(AMERTIME,AMERDEPT,0)
SET AMERDSCH=AMERDEPT
+52 QUIT
End DoDot:1
+53 IF $GET(^AMERVSIT(AMERDA,6))=""
Begin DoDot:1
+54 ;IHS/OIT/SCR 061809
DO EN^DDIOL("No DISCHARGE information available for this ERS VISIT^","","!!")
+55 SET AMERDSCH=0
+56 QUIT
End DoDot:1
+57 ;if there is missing information, print each
+58 SET AMERERR=$$PCCERROR(APCDTPRO,APCDTNQ,APCDTPOV,APCDTPAT,AMERDATE,AMERDSCH)
+59 IF AMERERR'=""
Begin DoDot:1
+60 SET AMERQUIT=1
+61 DO EN^DDIOL("***INSUFFICIENT DATA AVAILABLE FOR COMPLETE PCC VISIT***","","!!")
+62 DO EN^DDIOL("","","!")
+63 FOR AMERI=1:1
SET AMERWRIT=$PIECE(AMERERR,U,AMERI)
IF AMERWRIT=""
QUIT
DO EN^DDIOL($PIECE(AMERERR,U,AMERI),"","!")
+64 DO EN^DDIOL("***PLEASE CORRECT THESE PROBLEMS ***","","!!?10")
+65 DO EN^DDIOL("","","!")
+66 QUIT
End DoDot:1
+67 ;even if problems, save what you can
DO SYNCHPCC^AMERPCC(AMERDA)
+68 IF AMERQUIT
QUIT 0
+69 KILL AMERQUIT,APCDTPRO,APCDTNQ,APCTPAT,AMERTIME,APCDTPOV,AMERNAR,AMERPRIM
+70 KILL AMERDX,AMERDATE,AMERTIME,AMERDSCH,AMERDEPT,AMERPAT,AMERPROV
+71 QUIT 1
PCCERROR(PROVIDER,PRIMNAR,PRIMDIAG,PATIENT,AMERDATE,AMERDSCH) ;
+1 SET AMERERR=""
+2 IF PROVIDER=""
SET AMERERR=AMERERR_"Valid discharge provider missing^"
+3 IF PRIMNAR=""
SET AMERERR=AMERERR_"Primary provider narrative missing^"
+4 IF PRIMDIAG=""
SET AMERERR=AMERERR_"primary diagnosis is not coded^"
+5 IF PATIENT=""
SET AMERERR=AMERERR_"Valid patient identifier missing^"
+6 IF AMERDATE=""
SET AMERERR=AMERERR_"Time of visit cannot be in future^"
+7 IF AMERDSCH=""
SET AMERERR=AMERERR_"Discharge time must be after admission time^"
+8 QUIT AMERERR
