APCDALD.m

APCDALD ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ;

EP ;

 D PCCCHECK

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

 K APCDV("VISIT"),APCDV("VFILES")

 X ^APCDLINK(APCDLINK,2)

 D EOJ

 Q

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

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

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

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

 I $G(APCDPKG)="" S APCDQUIT=4 Q  ;required variable not passed

 I 'APCDPKG S APCDQUIT=5 Q  ;no package entry

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

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

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

PCCLINK ;check pcc link file info

 S APCDLINK=$O(^APCDLINK("C",APCDPKG,""))

 I APCDLINK="" S APCDQUIT=8 Q  ;no module link control

 I $P(^APCDLINK(APCDLINK,0),U,3)="" S APCDQUIT=9 Q  ;don't know array passed

 I '$D(^APCDLINK(APCDLINK,2)) S APCDQUIT=10 Q  ;no code to execute

 Q

 ;

EOJ ;

 K APCDPKG,APCDLINK,APCDQUIT,APCDERR,XMB,APCDDUZ,APCDVL,APCDVI,APCDV("VISIT"),APCDV("VFILES")

 Q

LBULL ;EP - SEND BULLETIN - LINK FAILURE

 ;pass APCDERR as narrative

 ;APCDALVR("APCDPAT")=patient

 ;APCDDATK=date of encounter

 ;APCDIEN=package ien of entry

 K XMB

 S XMB(1)=APCDIEN,XMB(2)=$P(^DPT(APCDALVR("APCDPAT"),0),U)_" (IEN "_APCDALVR("APCDPAT")_")",Y=APCDDATK D DD^%DT

 S XMB(3)=Y,XMB(4)=APCDERR,XMB(5)=$G(APCDPKG("NAME")),XMB(6)=APCDFILE,XMB="APCD PCC PACKAGE LINK FAIL",APCDDUZ=DUZ,DUZ=.5

 D ^XMB S DUZ=APCDDUZ K XMB,APCDERR

 Q

COMPLETE ;EP complete visit protocol call

 S APCDV("VISIT","9000010")=APCDVSIT

 I '$D(APCDV("VFILES")) S APCDVFLE=9000010 F APCDVL=0:0 S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)  D COMP2

 ;call protocol

 S X=+$O(^ORD(101,"B","APCD COMPLETE VISIT ADD",0))_";ORD(101,"

 D EN^XQOR

 K APCDV,X,Y,APCDVFLE,APCDVDG,APCDVIGR,APCDVDFN

 Q

COMP2 ;

 S APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDVSIT,APCDVDFN)"

 S APCDVDFN="" F APCDVI=1:1 S APCDVDFN=$O(@APCDVIGR) Q:APCDVDFN=""  S APCDV(APCDVFLE,APCDVDFN)=""

 Q

 ;

 ;

APCDALD   ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ;

EP        ;

 +1        DO PCCCHECK

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

           IF $GET(APCDQUIT)

               DO EOJ

               QUIT 

 +3        KILL APCDV("VISIT"),APCDV("VFILES")

 +4        XECUTE ^APCDLINK(APCDLINK,2)

 +5        DO EOJ

 +6        QUIT 

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

 +1       ;no site file

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

               SET APCDQUIT=1

               QUIT 

 +2       ;pcc not running 

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

               SET APCDQUIT=2

               QUIT 

 +3       ;no pcc master control file entry

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

               SET APCDQUIT=3

               QUIT 

 +4       ;required variable not passed

           IF $GET(APCDPKG)=""

               SET APCDQUIT=4

               QUIT 

 +5       ;no package entry

           IF 'APCDPKG

               SET APCDQUIT=5

               QUIT 

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

 +7       ;no pcc master control entry for package

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

               SET APCDQUIT=6

               QUIT 

 +8       ;don't want to pass data

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

               SET APCDQUIT=7

               QUIT 

PCCLINK   ;check pcc link file info

 +1        SET APCDLINK=$ORDER(^APCDLINK("C",APCDPKG,""))

 +2       ;no module link control

           IF APCDLINK=""

               SET APCDQUIT=8

               QUIT 

 +3       ;don't know array passed

           IF $PIECE(^APCDLINK(APCDLINK,0),U,3)=""

               SET APCDQUIT=9

               QUIT 

 +4       ;no code to execute

           IF '$DATA(^APCDLINK(APCDLINK,2))

               SET APCDQUIT=10

               QUIT 

 +5        QUIT 

 +6       ;

EOJ       ;

 +1        KILL APCDPKG,APCDLINK,APCDQUIT,APCDERR,XMB,APCDDUZ,APCDVL,APCDVI,APCDV("VISIT"),APCDV("VFILES")

 +2        QUIT 

LBULL     ;EP - SEND BULLETIN - LINK FAILURE

 +1       ;pass APCDERR as narrative

 +2       ;APCDALVR("APCDPAT")=patient

 +3       ;APCDDATK=date of encounter

 +4       ;APCDIEN=package ien of entry

 +5        KILL XMB

 +6        SET XMB(1)=APCDIEN

           SET XMB(2)=$PIECE(^DPT(APCDALVR("APCDPAT"),0),U)_" (IEN "_APCDALVR("APCDPAT")_")"

           SET Y=APCDDATK

           DO DD^%DT

 +7        SET XMB(3)=Y

           SET XMB(4)=APCDERR

           SET XMB(5)=$GET(APCDPKG("NAME"))

           SET XMB(6)=APCDFILE

           SET XMB="APCD PCC PACKAGE LINK FAIL"

           SET APCDDUZ=DUZ

           SET DUZ=.5

 +8        DO ^XMB

           SET DUZ=APCDDUZ

           KILL XMB,APCDERR

 +9        QUIT 

COMPLETE  ;EP complete visit protocol call

 +1        SET APCDV("VISIT","9000010")=APCDVSIT

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

               SET APCDVFLE=9000010

               FOR APCDVL=0:0

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

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

                       QUIT 

                   DO COMP2

 +3       ;call protocol

 +4        SET X=+$ORDER(^ORD(101,"B","APCD COMPLETE VISIT ADD",0))_";ORD(101,"

 +5        DO EN^XQOR

 +6        KILL APCDV,X,Y,APCDVFLE,APCDVDG,APCDVIGR,APCDVDFN

 +7        QUIT 

COMP2     ;

 +1        SET APCDVDG=^DIC(APCDVFLE,0,"GL")

           SET APCDVIGR=APCDVDG_"""AD"",APCDVSIT,APCDVDFN)"

 +2        SET APCDVDFN=""

           FOR APCDVI=1:1

               SET APCDVDFN=$ORDER(@APCDVIGR)

               IF APCDVDFN=""

                   QUIT 

               SET APCDV(APCDVFLE,APCDVDFN)=""

 +3        QUIT 

 +4       ;

 +5       ;