AMHBHDEL ; IHS/CMI/LAB - GUI V FILE VISIT CREATION ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;;
TEST ;
D EN(.RETVAL,0)
Q
EN(AMHARRAY,AMHR) ;EP CALL
S AMHERR="",ZTQUEUED=""
;AMHR must be ien of MHSS RECORD that is to be deleted
D
.NEW AMHACTN
.S AMHACTN=4
.D CHECKREC Q:AMHERR'=""
.D DELETE
I AMHERR="" D MSG("1") Q
I AMHERR'="" D ERROR(AMHERR)
D KILL
Q
;
CHECKREC ;
I '$G(AMHR) S AMHERR="IEN MISSING" Q
I '$D(^AMHREC(AMHR)) S AMHERR="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(AMHX) ;
D MSG("-1"_$C(30)_AMHX)
Q
;
MSG(AMHX) ;
S AMHARRAY=AMHX
Q
;
;
KILL ;
K APCDALVR,AMHPARM,AMHERR,AMHVAL,AMHR,AMHACTN,AMHBL,AMHLPCC,AMHVDLT,AMHLPCCT,AMHVISIT
Q
AMHBHDEL ; IHS/CMI/LAB - GUI V FILE VISIT CREATION ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;;
TEST ;
+1 DO EN(.RETVAL,0)
+2 QUIT
EN(AMHARRAY,AMHR) ;EP CALL
+1 SET AMHERR=""
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 AMHERR'=""
QUIT
+7 DO DELETE
End DoDot:1
+8 IF AMHERR=""
DO MSG("1")
QUIT
+9 IF AMHERR'=""
DO ERROR(AMHERR)
+10 DO KILL
+11 QUIT
+12 ;
CHECKREC ;
+1 IF '$GET(AMHR)
SET AMHERR="IEN MISSING"
QUIT
+2 IF '$DATA(^AMHREC(AMHR))
SET AMHERR="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(AMHX) ;
+1 DO MSG("-1"_$CHAR(30)_AMHX)
+2 QUIT
+3 ;
MSG(AMHX) ;
+1 SET AMHARRAY=AMHX
+2 QUIT
+3 ;
+4 ;
KILL ;
+1 KILL APCDALVR,AMHPARM,AMHERR,AMHVAL,AMHR,AMHACTN,AMHBL,AMHLPCC,AMHVDLT,AMHLPCCT,AMHVISIT
+2 QUIT
