AMHLRDEL.m

AMHLRDEL ; IHS/CMI/LAB - DELETE BH RECORD ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

EN ;

 W $C(7),$C(7)

DELETE ;

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

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

 D EOJ

 Q

 ;

DELETE2 ;

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

 S AMHVDG=^DIC(AMHVFLE,0,"GL"),AMHVIGR=AMHVDG_"""AD"",AMHR,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,AMHR,AMHVFLE,AMHVI,AMHVIGR,AMHVL,AMHVNM

 K %,X

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

 Q

AMHLRDEL  ; IHS/CMI/LAB - DELETE BH RECORD ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

EN        ;

 +1        WRITE $CHAR(7),$CHAR(7)

DELETE    ;

 +1        SET AMHVFLE=9002011

           FOR AMHVL=0:0

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

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

                   QUIT 

               DO DELETE2

 +2        SET DIK="^AMHREC("

           SET DA=AMHR

           SET X=2

           DO ^DIK

           KILL DA,DIK

 +3        DO EOJ

 +4        QUIT 

 +5       ;

DELETE2   ;

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

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

           SET AMHVIGR=AMHVDG_"""AD"",AMHR,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,AMHR,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