AMH30P1.m

AMH30P1 ; IHS/CMI/LAB - POST INIT BH ;   [ 04/27/04  2:31 PM ]

 ;;3.0;IHS BEHAVIORAL HEALTH;**1**;JAN 27, 2003

 ;re-index all cross references on Designated provider fields

 ;

ENV ;EP 

 I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

 Q

 ;

PRE ;

 S DIK="^DD(9002011.55,",DA=.13,DA(1)=9002011.55 D ^DIK

 S DIK="^DD(9002011.51,",DA=.06,DA(1)=9002011.51 D ^DIK

 S DIK="^DD(9002011,",DA=.17,DA(1)=9002011 D ^DIK

 S DA=$O(^AMHTACT("B",32,0)) I DA S DIE="^AMHTACT(",DR=".02///CLINICAL SUPERVISION PROVIDED" D ^DIE K DIE,DA,DR

 S DA=$O(^AMHPROB("B",19,0))

 I DA S DIE="^AMHPROB(",DR=".02///PERSONALITY DISORDER" D ^DIE

 S DA=$O(^AMHPROBC("B",19,0))

 I DA S DIE="^AMHPROBC(",DR=".02///PERSONALITY DISORDER" D ^DIE

 D ^XBFMK

 S DA=$O(^AMHTSDRG("B","TYLENOL (ACETOMINOPHEN)",0))

 I DA S DIE="^AMHTSDRG(",DR=".01///TYLENOL (ACETAMINOPHEN)" D ^DIE K DA,DR,DIE

 S DA=$O(^AMHTSDRG("B","TRICYLCLIC ANTIDEPRESSANTS (TC",0))

 I DA S DIE="^AMHTSDRG(",DR=".01///TRICYCLIC ANTIDEPRESSANT (TCA)" D ^DIE

 D ^XBFMK

 S X=0 F  S X=$O(^AMHTPLT(X)) Q:X'=+X  S $P(^AMHTPLT(X,0),U,2)=""

 F DA=1:1:200 S DIK="^AMHSORT(" D ^DIK

 Q

POST ;EP

 NEW X S X=$$ADD^XPDMENU("AMH M PROBLEM SPECIFIC","AMH P SUICIDE DELIMITED","SDEL")

 I 'X W "Attempt to add suicide delimited option failed.." H 3

 K ^AMHPATR("AOP")

 ;convert .13 to free text

 S X=0 F  S X=$O(^AMHPATR(X)) Q:X'=+X  D

 .Q:$P(^AMHPATR(X,0),U,13)=""

 .S Y=$P(^AMHPATR(X,0),U,13)

 .Q:'Y

 .S $P(^AMHPATR(X,0),U,13)=$P(^VA(200,Y,0),U)

 .Q

 S X=0 F  S X=$O(^AMHPCASE(X)) Q:X'=+X  I $P(^AMHPCASE(X,0),U,3)="A" S $P(^AMHPCASE(X,0),U,3)="C"

 ;REINDEX AVISIT

 S DIK="^AMHREC(",DIK(1)=".16" D ENALL^DIK

 Q

 ;;

 ;

 ;;

 ;

AMH30P1   ; IHS/CMI/LAB - POST INIT BH ;   [ 04/27/04  2:31 PM ]

 +1       ;;3.0;IHS BEHAVIORAL HEALTH;**1**;JAN 27, 2003

 +2       ;re-index all cross references on Designated provider fields

 +3       ;

ENV       ;EP 

 +1        IF $GET(XPDENV)=1

               SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

 +2        QUIT 

 +3       ;

PRE       ;

 +1        SET DIK="^DD(9002011.55,"

           SET DA=.13

           SET DA(1)=9002011.55

           DO ^DIK

 +2        SET DIK="^DD(9002011.51,"

           SET DA=.06

           SET DA(1)=9002011.51

           DO ^DIK

 +3        SET DIK="^DD(9002011,"

           SET DA=.17

           SET DA(1)=9002011

           DO ^DIK

 +4        SET DA=$ORDER(^AMHTACT("B",32,0))

           IF DA

               SET DIE="^AMHTACT("

               SET DR=".02///CLINICAL SUPERVISION PROVIDED"

               DO ^DIE

               KILL DIE,DA,DR

 +5        SET DA=$ORDER(^AMHPROB("B",19,0))

 +6        IF DA

               SET DIE="^AMHPROB("

               SET DR=".02///PERSONALITY DISORDER"

               DO ^DIE

 +7        SET DA=$ORDER(^AMHPROBC("B",19,0))

 +8        IF DA

               SET DIE="^AMHPROBC("

               SET DR=".02///PERSONALITY DISORDER"

               DO ^DIE

 +9        DO ^XBFMK

 +10       SET DA=$ORDER(^AMHTSDRG("B","TYLENOL (ACETOMINOPHEN)",0))

 +11       IF DA

               SET DIE="^AMHTSDRG("

               SET DR=".01///TYLENOL (ACETAMINOPHEN)"

               DO ^DIE

               KILL DA,DR,DIE

 +12       SET DA=$ORDER(^AMHTSDRG("B","TRICYLCLIC ANTIDEPRESSANTS (TC",0))

 +13       IF DA

               SET DIE="^AMHTSDRG("

               SET DR=".01///TRICYCLIC ANTIDEPRESSANT (TCA)"

               DO ^DIE

 +14       DO ^XBFMK

 +15       SET X=0

           FOR 

               SET X=$ORDER(^AMHTPLT(X))

               IF X'=+X

                   QUIT 

               SET $PIECE(^AMHTPLT(X,0),U,2)=""

 +16       FOR DA=1:1:200

               SET DIK="^AMHSORT("

               DO ^DIK

 +17       QUIT 

POST      ;EP

 +1        NEW X

           SET X=$$ADD^XPDMENU("AMH M PROBLEM SPECIFIC","AMH P SUICIDE DELIMITED","SDEL")

 +2        IF 'X

               WRITE "Attempt to add suicide delimited option failed.."

               HANG 3

 +3        KILL ^AMHPATR("AOP")

 +4       ;convert .13 to free text

 +5        SET X=0

           FOR 

               SET X=$ORDER(^AMHPATR(X))

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +6                IF $PIECE(^AMHPATR(X,0),U,13)=""

                       QUIT 

 +7                SET Y=$PIECE(^AMHPATR(X,0),U,13)

 +8                IF 'Y

                       QUIT 

 +9                SET $PIECE(^AMHPATR(X,0),U,13)=$PIECE(^VA(200,Y,0),U)

 +10               QUIT 

               End DoDot:1

 +11       SET X=0

           FOR 

               SET X=$ORDER(^AMHPCASE(X))

               IF X'=+X

                   QUIT 

               IF $PIECE(^AMHPCASE(X,0),U,3)="A"

                   SET $PIECE(^AMHPCASE(X,0),U,3)="C"

 +12      ;REINDEX AVISIT

 +13       SET DIK="^AMHREC("

           SET DIK(1)=".16"

           DO ENALL^DIK

 +14       QUIT 

 +15      ;;

 +16      ;

 +17      ;;

 +18      ;