- 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 ;