BCHEXC1.m

BCHEXC1 ; IHS/CMI/LAB - RECORD REVIEW PROCESS ; 

 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 ;IHS/CMI/LAB - patch 10 new record format

 ;IHS/CMI/LAB tmp to xtmp, fix undef error

 ;

 ;Continuation of BCHEXC.  Record Review.

 ;

 ;

 ;

START ;

 S ^XTMP("BCHEXC",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"CHR EXPORT CHECK"

 S (BCHBT,BCHBTH)=$H,BCHJOB=$J,BCH("ERROR COUNT")=0,BCHO("RUN")="NEW"

 D DATE,XIT

 Q

 ;

DATE ; Run by date of service

 S X1=BCHBD,X2=-1 D C^%DTC S BCHSD=X

 S BCHODAT=BCHSD_".9999" F  S BCHODAT=$O(^BCHR("AEX",BCHODAT)) Q:BCHODAT=""!((BCHODAT\1)>BCHED)  D D1

 Q

 ;

XIT ;

 S BCHET=$H

 D EOJ

 Q

EOJ ;

 Q

D1 ;

 S (BCHR,BCHRCNT)=0 F  S BCHR=$O(^BCHR("AEX",BCHODAT,BCHR)) Q:BCHR'=+BCHR  I $D(^BCHR(BCHR,0)) S BCHREC=^BCHR(BCHR,0) D PROC

 Q

PROC ;

 K BCHE S BCHE=""

 S (X,C)=0 F  S X=$O(^BCHRPROB("AD",BCHR,X)) Q:X'=+X  S C=C+1

 I C=0 S BCHE="E021" G ER

 S X=0 F  S X=$O(^BCHRPROB("AD",BCHR,X)) Q:X'=+X  D

 .I $P(^BCHRPROB(X,0),U,4)="" S BCHE="E009" Q

 .I $P(^BCHRPROB(X,0),U,5)="" S BCHE="E026" Q

 .Q

 I BCHE="" D ^BCHEXD21

ER ;

 Q:$G(BCHE)=""

 S BCH("ERROR COUNT")=BCH("ERROR COUNT")+1

 S BCHE("ERR DFN")=$O(^BCHERR("B",BCHE,"")) I BCHE("ERR DFN")="" S BCHE("MSG")=BCHE_"-ERROR INFORMATION NOT IN ERROR FILE" G ERR

 S BCHE("MSG")=BCHE_"-"_$P(^BCHERR(BCHE("ERR DFN"),0),U,2) S:$L(BCHE("MSG"))=5 BCHE("MSG")=BCHE("MSG")_"- ERROR INFORMATION NOT IN ERROR FILE" S BCHE("MSG")=$E(BCHE("MSG"),1,45)

ERR S ^XTMP("BCHEXC",BCHJOB,BCHBT,"ERRORS",BCHR)=BCHE("MSG")

 Q

 ;

BCHEXC1   ; IHS/CMI/LAB - RECORD REVIEW PROCESS ; 

 +1       ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 +2       ;IHS/CMI/LAB - patch 10 new record format

 +3       ;IHS/CMI/LAB tmp to xtmp, fix undef error

 +4       ;

 +5       ;Continuation of BCHEXC.  Record Review.

 +6       ;

 +7       ;

 +8       ;

START     ;

 +1        SET ^XTMP("BCHEXC",0)=$$FMADD^XLFDT(DT,14)_U_DT_U_"CHR EXPORT CHECK"

 +2        SET (BCHBT,BCHBTH)=$HOROLOG

           SET BCHJOB=$JOB

           SET BCH("ERROR COUNT")=0

           SET BCHO("RUN")="NEW"

 +3        DO DATE

           DO XIT

 +4        QUIT 

 +5       ;

DATE      ; Run by date of service

 +1        SET X1=BCHBD

           SET X2=-1

           DO C^%DTC

           SET BCHSD=X

 +2        SET BCHODAT=BCHSD_".9999"

           FOR 

               SET BCHODAT=$ORDER(^BCHR("AEX",BCHODAT))

               IF BCHODAT=""!((BCHODAT\1)>BCHED)

                   QUIT 

               DO D1

 +3        QUIT 

 +4       ;

XIT       ;

 +1        SET BCHET=$HOROLOG

 +2        DO EOJ

 +3        QUIT 

EOJ       ;

 +1        QUIT 

D1        ;

 +1        SET (BCHR,BCHRCNT)=0

           FOR 

               SET BCHR=$ORDER(^BCHR("AEX",BCHODAT,BCHR))

               IF BCHR'=+BCHR

                   QUIT 

               IF $DATA(^BCHR(BCHR,0))

                   SET BCHREC=^BCHR(BCHR,0)

                   DO PROC

 +2        QUIT 

PROC      ;

 +1        KILL BCHE

           SET BCHE=""

 +2        SET (X,C)=0

           FOR 

               SET X=$ORDER(^BCHRPROB("AD",BCHR,X))

               IF X'=+X

                   QUIT 

               SET C=C+1

 +3        IF C=0

               SET BCHE="E021"

               GOTO ER

 +4        SET X=0

           FOR 

               SET X=$ORDER(^BCHRPROB("AD",BCHR,X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +5                IF $PIECE(^BCHRPROB(X,0),U,4)=""

                       SET BCHE="E009"

                       QUIT 

 +6                IF $PIECE(^BCHRPROB(X,0),U,5)=""

                       SET BCHE="E026"

                       QUIT 

 +7                QUIT 

               End DoDot:1

 +8        IF BCHE=""

               DO ^BCHEXD21

ER        ;

 +1        IF $GET(BCHE)=""

               QUIT 

 +2        SET BCH("ERROR COUNT")=BCH("ERROR COUNT")+1

 +3        SET BCHE("ERR DFN")=$ORDER(^BCHERR("B",BCHE,""))

           IF BCHE("ERR DFN")=""

               SET BCHE("MSG")=BCHE_"-ERROR INFORMATION NOT IN ERROR FILE"

               GOTO ERR

 +4        SET BCHE("MSG")=BCHE_"-"_$PIECE(^BCHERR(BCHE("ERR DFN"),0),U,2)

           IF $LENGTH(BCHE("MSG"))=5

               SET BCHE("MSG")=BCHE("MSG")_"- ERROR INFORMATION NOT IN ERROR FILE"

           SET BCHE("MSG")=$EXTRACT(BCHE("MSG"),1,45)

ERR        SET ^XTMP("BCHEXC",BCHJOB,BCHBT,"ERRORS",BCHR)=BCHE("MSG")

 +1        QUIT 

 +2       ;