BCHALD.m

BCHALD ; IHS/CMI/LAB - PCC LINK - NO LONGER USED ; 

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

 ;

 ;

EP ;

 Q   ;PER V2.0 SPECS NO PCC LINK

 D PCCCHECK

 I $G(BCHQUIT) D EOJ Q  ;something is wrong or don't want to pass  data

 K BCHV("VISIT"),BCHV("VFILES")

 D ^BCHABCH

 D EOJ

 Q

PCCCHECK ;check to see if link to pcc active, set BCHLPCC IF SO

 I '$D(^AUTTSITE(1,0)) S BCHQUIT=1 Q  ;no site file

 I $P(^AUTTSITE(1,0),U,8)'="Y" S BCHQUIT=2 Q  ;pcc not running 

 I '$D(^APCCCTRL(DUZ(2),0))#2 S BCHQUIT=3 Q  ;no pcc master control file entry

 I $G(BCHPKG)="" S BCHQUIT=4 Q  ;required variable not passed

 I 'BCHPKG S BCHQUIT=5 Q  ;no package entry

 S BCHPKG("NAME")=$P(^DIC(9.4,BCHPKG,0),U)

 I '$D(^APCCCTRL(DUZ(2),11,BCHPKG,0))#2 S BCHQUIT=6 Q  ;no pcc master control entry for package

 I '$P(^APCCCTRL(DUZ(2),11,BCHPKG,0),U,2) S BCHQUIT=7 Q  ;don't want to pass data

 Q

 ;

EOJ ;

 K BCHPKG,BCHQUIT,BCHERR,XMB,BCHDUZ,BCHVL,BCHVI,BCHV("VISIT"),BCHV("VFILES")

 Q

LBULL ;EP - SEND BULLETIN - LINK FAILURE

 ;pass BCHERR as narrative

 ;DFN=patient

 ;BCHDATK=date of encounter

 ;BCHIEN=package ien of entry

 ;K XMB

 ;S XMB(1)=BCHIEN,XMB(2)=$P(^DPT(DFN,0),U)_" (IEN "_DFN_")",Y=BCHDATK D DD^%DT

 ;S XMB(8)=$$VAL^XBDIQ1(90002,BCHIEN,.03),XMB(9)=$$VAL^XBDIQ1(90002,BCHIEN,.02)

 ;S XMB(3)=Y,XMB(4)=BCHERR,XMB(5)=$G(BCHPKG("NAME")),XMB(6)=BCHFILE,XMB(7)=$$HRN^AUPNPAT(DFN,DUZ(2)),XMB="BCH PCC PACKAGE LINK FAIL",BCHDUZ=DUZ,DUZ=.5

 ;D ^XMB S DUZ=BCHDUZ K XMB,BCHERR

 Q

COMPLETE ;EP complete visit protocol call

 S BCHV("VISIT","9000010")=BCHVSIT

 I '$D(BCHV("VFILES")) S BCHVFLE=9000010 F BCHVL=0:0 S BCHVFLE=$O(^DIC(BCHVFLE)) Q:BCHVFLE>9000010.99!(BCHVFLE'=+BCHVFLE)  D COMP2

 D UPDPCC^BCHUTIL

 K BCHV,X,Y,BCHVFLE,BCHVDG,BCHVIGR,BCHVDFN

 Q

COMP2 ;

 S BCHVDG=^DIC(BCHVFLE,0,"GL"),BCHVIGR=BCHVDG_"""AD"",BCHVSIT,BCHVDFN)"

 S BCHVDFN="" F BCHVI=1:1 S BCHVDFN=$O(@BCHVIGR) Q:BCHVDFN=""  S BCHV(BCHVFLE,BCHVDFN)=""

 Q

 ;

 ;

BCHALD    ; IHS/CMI/LAB - PCC LINK - NO LONGER USED ; 

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

 +2       ;

 +3       ;

EP        ;

 +1       ;PER V2.0 SPECS NO PCC LINK

           QUIT 

 +2        DO PCCCHECK

 +3       ;something is wrong or don't want to pass  data

           IF $GET(BCHQUIT)

               DO EOJ

               QUIT 

 +4        KILL BCHV("VISIT"),BCHV("VFILES")

 +5        DO ^BCHABCH

 +6        DO EOJ

 +7        QUIT 

PCCCHECK  ;check to see if link to pcc active, set BCHLPCC IF SO

 +1       ;no site file

           IF '$DATA(^AUTTSITE(1,0))

               SET BCHQUIT=1

               QUIT 

 +2       ;pcc not running 

           IF $PIECE(^AUTTSITE(1,0),U,8)'="Y"

               SET BCHQUIT=2

               QUIT 

 +3       ;no pcc master control file entry

           IF '$DATA(^APCCCTRL(DUZ(2),0))#2

               SET BCHQUIT=3

               QUIT 

 +4       ;required variable not passed

           IF $GET(BCHPKG)=""

               SET BCHQUIT=4

               QUIT 

 +5       ;no package entry

           IF 'BCHPKG

               SET BCHQUIT=5

               QUIT 

 +6        SET BCHPKG("NAME")=$PIECE(^DIC(9.4,BCHPKG,0),U)

 +7       ;no pcc master control entry for package

           IF '$DATA(^APCCCTRL(DUZ(2),11,BCHPKG,0))#2

               SET BCHQUIT=6

               QUIT 

 +8       ;don't want to pass data

           IF '$PIECE(^APCCCTRL(DUZ(2),11,BCHPKG,0),U,2)

               SET BCHQUIT=7

               QUIT 

 +9        QUIT 

 +10      ;

EOJ       ;

 +1        KILL BCHPKG,BCHQUIT,BCHERR,XMB,BCHDUZ,BCHVL,BCHVI,BCHV("VISIT"),BCHV("VFILES")

 +2        QUIT 

LBULL     ;EP - SEND BULLETIN - LINK FAILURE

 +1       ;pass BCHERR as narrative

 +2       ;DFN=patient

 +3       ;BCHDATK=date of encounter

 +4       ;BCHIEN=package ien of entry

 +5       ;K XMB

 +6       ;S XMB(1)=BCHIEN,XMB(2)=$P(^DPT(DFN,0),U)_" (IEN "_DFN_")",Y=BCHDATK D DD^%DT

 +7       ;S XMB(8)=$$VAL^XBDIQ1(90002,BCHIEN,.03),XMB(9)=$$VAL^XBDIQ1(90002,BCHIEN,.02)

 +8       ;S XMB(3)=Y,XMB(4)=BCHERR,XMB(5)=$G(BCHPKG("NAME")),XMB(6)=BCHFILE,XMB(7)=$$HRN^AUPNPAT(DFN,DUZ(2)),XMB="BCH PCC PACKAGE LINK FAIL",BCHDUZ=DUZ,DUZ=.5

 +9       ;D ^XMB S DUZ=BCHDUZ K XMB,BCHERR

 +10       QUIT 

COMPLETE  ;EP complete visit protocol call

 +1        SET BCHV("VISIT","9000010")=BCHVSIT

 +2        IF '$DATA(BCHV("VFILES"))

               SET BCHVFLE=9000010

               FOR BCHVL=0:0

                   SET BCHVFLE=$ORDER(^DIC(BCHVFLE))

                   IF BCHVFLE>9000010.99!(BCHVFLE'=+BCHVFLE)

                       QUIT 

                   DO COMP2

 +3        DO UPDPCC^BCHUTIL

 +4        KILL BCHV,X,Y,BCHVFLE,BCHVDG,BCHVIGR,BCHVDFN

 +5        QUIT 

COMP2     ;

 +1        SET BCHVDG=^DIC(BCHVFLE,0,"GL")

           SET BCHVIGR=BCHVDG_"""AD"",BCHVSIT,BCHVDFN)"

 +2        SET BCHVDFN=""

           FOR BCHVI=1:1

               SET BCHVDFN=$ORDER(@BCHVIGR)

               IF BCHVDFN=""

                   QUIT 

               SET BCHV(BCHVFLE,BCHVDFN)=""

 +3        QUIT 

 +4       ;

 +5       ;