BPCBHDEL.m

BPCBHDEL ; IHS/OIT/MJL - GUI V FILE VISIT CREATION ;

 ;;1.5;BPC;;MAY 26, 2005

 ;;

TEST ;

 D EN(.RETVAL,24609)

 Q

EN(BPCARRAY,AMHR) ;EP CALL

 S BPCERR="",ZTQUEUED=""

 ;AMHR must be ien of MHSS RECORD that is to be deleted

 D

 .NEW AMHACTN

 .S AMHACTN=4

 .D CHECKREC Q:BPCERR'=""

 .D DELETE

 I BPCERR="" D MSG("1") Q

 I BPCERR'="" D ERROR(BPCERR)

 D KILL

 Q

 ;

CHECKREC ;

 I '$G(AMHR) S BPCERR="IEN MISSING" Q

 I '$D(^AMHREC(AMHR)) S BPCERR="INVALID RECORD IEN PASSED" Q

 Q

DELETE ;

 S AMHVDLT=$P(^AMHREC(AMHR,0),U,16)

 S AMHRDEL=AMHR

 S AMHVFLE=9002011 F AMHVL=0:0 S AMHVFLE=$O(^DIC(AMHVFLE)) Q:AMHVFLE>9002011.49!(AMHVFLE'=+AMHVFLE)  D DELETE2

 S DA=$O(^AMHRCDST("B",AMHRDEL,0)) I DA S DIK="^AMHRCDST(" D ^DIK ;delete staging tool

 S DIK="^AMHREC(",DA=AMHRDEL,X=2 D ^DIK K DA,DIK

 D EOJ

 D PCCCHECK

 D PCCLINK

 Q

 ;

DELETE2 ;

 S AMHVNM=$P(^DIC(AMHVFLE,0),U)

 S AMHVDG=^DIC(AMHVFLE,0,"GL"),AMHVIGR=AMHVDG_"""AD"",AMHRDEL,AMHVDFN)"

 S AMHVDFN="" F AMHVI=1:1 S AMHVDFN=$O(@AMHVIGR) Q:AMHVDFN=""  W:'$D(ZTQUEUED) "." S DIK=AMHVDG,DA=AMHVDFN D ^DIK

 Q

 ;

EOJ ; EOJ CLEANUP

 K AMHVDFN,AMHVDG,AMHRDEL,AMHVFLE,AMHVI,AMHVIGR,AMHVL,AMHVNM

 K %,X

 K D,D0,DA,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR,DIK

 Q

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

 K AMHLPCC

 S (AMHLPCC,AMHLPCCT)=$P(^AMHSITE(DUZ(2),0),U,12) I AMHLPCC S AMHLPCC=AMHLPCC-1

 I AMHLPCC="" S AMHLPCC=0 Q

 Q:'AMHLPCC

 I $D(^AUTTSITE(1,0)),$P(^(0),U,8)="Y",'$D(^APCCCTRL(DUZ(2),0))#2 S AMHLPCC=0 Q

 S AMHPKG=$O(^DIC(9.4,"C","AMH",""))

 I '$D(^APCCCTRL(DUZ(2),11,AMHPKG,0))#2 S AMHLPCC=0 Q

 I $D(^AUTTSITE(1,0)),$P(^(0),U,8)="Y",$D(^APCCCTRL(DUZ(2),0))#2,$D(^APCCCTRL(DUZ(2),11,AMHPKG,0))#2,$P(^(0),U,2) S AMHLPCC=AMHLPCC

 E  S AMHLPCC=0

 K AMHPKG

 Q

PCCLINK ;EP - PCCLINK

 Q:'AMHLPCC  ;quit if no pcc link

 I $G(AMHVDLT)="",AMHACTN=4 Q

 S AMHBL=1

 S APCDVDLT=$G(AMHVDLT) I APCDVDLT="" Q

 D ^APCDVDLT K APCDVDLT,AMHBL

 Q

 ;

ERROR(BPCX) ;

 D MSG("-1"_$C(30)_BPCX)

 Q

 ;

MSG(BPCX) ;

 S BPCARRAY=BPCX

 Q

 ;

 ;

KILL ;

 K APCDALVR,BPCPARM,BPCERR,BPCVAL,AMHR,AMHACTN,AMHBL,AMHLPCC,AMHVDLT,AMHLPCCT,AMHVISIT

 Q

BPCBHDEL  ; IHS/OIT/MJL - GUI V FILE VISIT CREATION ;

 +1       ;;1.5;BPC;;MAY 26, 2005

 +2       ;;

TEST      ;

 +1        DO EN(.RETVAL,24609)

 +2        QUIT 

EN(BPCARRAY,AMHR) ;EP CALL

 +1        SET BPCERR=""

           SET ZTQUEUED=""

 +2       ;AMHR must be ien of MHSS RECORD that is to be deleted

 +3        Begin DoDot:1

 +4            NEW AMHACTN

 +5            SET AMHACTN=4

 +6            DO CHECKREC

               IF BPCERR'=""

                   QUIT 

 +7            DO DELETE

           End DoDot:1

 +8        IF BPCERR=""

               DO MSG("1")

               QUIT 

 +9        IF BPCERR'=""

               DO ERROR(BPCERR)

 +10       DO KILL

 +11       QUIT 

 +12      ;

CHECKREC  ;

 +1        IF '$GET(AMHR)

               SET BPCERR="IEN MISSING"

               QUIT 

 +2        IF '$DATA(^AMHREC(AMHR))

               SET BPCERR="INVALID RECORD IEN PASSED"

               QUIT 

 +3        QUIT 

DELETE    ;

 +1        SET AMHVDLT=$PIECE(^AMHREC(AMHR,0),U,16)

 +2        SET AMHRDEL=AMHR

 +3        SET AMHVFLE=9002011

           FOR AMHVL=0:0

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

               IF AMHVFLE>9002011.49!(AMHVFLE'=+AMHVFLE)

                   QUIT 

               DO DELETE2

 +4       ;delete staging tool

           SET DA=$ORDER(^AMHRCDST("B",AMHRDEL,0))

           IF DA

               SET DIK="^AMHRCDST("

               DO ^DIK

 +5        SET DIK="^AMHREC("

           SET DA=AMHRDEL

           SET X=2

           DO ^DIK

           KILL DA,DIK

 +6        DO EOJ

 +7        DO PCCCHECK

 +8        DO PCCLINK

 +9        QUIT 

 +10      ;

DELETE2   ;

 +1        SET AMHVNM=$PIECE(^DIC(AMHVFLE,0),U)

 +2        SET AMHVDG=^DIC(AMHVFLE,0,"GL")

           SET AMHVIGR=AMHVDG_"""AD"",AMHRDEL,AMHVDFN)"

 +3        SET AMHVDFN=""

           FOR AMHVI=1:1

               SET AMHVDFN=$ORDER(@AMHVIGR)

               IF AMHVDFN=""

                   QUIT 

               IF '$DATA(ZTQUEUED)

                   WRITE "."

               SET DIK=AMHVDG

               SET DA=AMHVDFN

               DO ^DIK

 +4        QUIT 

 +5       ;

EOJ       ; EOJ CLEANUP

 +1        KILL AMHVDFN,AMHVDG,AMHRDEL,AMHVFLE,AMHVI,AMHVIGR,AMHVL,AMHVNM

 +2        KILL %,X

 +3        KILL D,D0,DA,DIC,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR,DIK

 +4        QUIT 

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

 +1        KILL AMHLPCC

 +2        SET (AMHLPCC,AMHLPCCT)=$PIECE(^AMHSITE(DUZ(2),0),U,12)

           IF AMHLPCC

               SET AMHLPCC=AMHLPCC-1

 +3        IF AMHLPCC=""

               SET AMHLPCC=0

               QUIT 

 +4        IF 'AMHLPCC

               QUIT 

 +5        IF $DATA(^AUTTSITE(1,0))

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

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

                       SET AMHLPCC=0

                       QUIT 

 +6        SET AMHPKG=$ORDER(^DIC(9.4,"C","AMH",""))

 +7        IF '$DATA(^APCCCTRL(DUZ(2),11,AMHPKG,0))#2

               SET AMHLPCC=0

               QUIT 

 +8        IF $DATA(^AUTTSITE(1,0))

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

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

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

                           IF $PIECE(^(0),U,2)

                               SET AMHLPCC=AMHLPCC

 +9       IF '$TEST

               SET AMHLPCC=0

 +10       KILL AMHPKG

 +11       QUIT 

PCCLINK   ;EP - PCCLINK

 +1       ;quit if no pcc link

           IF 'AMHLPCC

               QUIT 

 +2        IF $GET(AMHVDLT)=""

               IF AMHACTN=4

                   QUIT 

 +3        SET AMHBL=1

 +4        SET APCDVDLT=$GET(AMHVDLT)

           IF APCDVDLT=""

               QUIT 

 +5        DO ^APCDVDLT

           KILL APCDVDLT,AMHBL

 +6        QUIT 

 +7       ;

ERROR(BPCX) ;

 +1        DO MSG("-1"_$CHAR(30)_BPCX)

 +2        QUIT 

 +3       ;

MSG(BPCX) ;

 +1        SET BPCARRAY=BPCX

 +2        QUIT 

 +3       ;

 +4       ;

KILL      ;

 +1        KILL APCDALVR,BPCPARM,BPCERR,BPCVAL,AMHR,AMHACTN,AMHBL,AMHLPCC,AMHVDLT,AMHLPCCT,AMHVISIT

 +2        QUIT