Routine: AMEREDPC

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

AMEREDPC.m