AMH30P3.m

AMH30P3 ; IHS/CMI/LAB - POST INIT BH ;   [ 09/14/04  6:55 AM ]

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

 ;

 ;LORI -SEND OUT LISTER ITEMS

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

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

 I DA S DIE="^AMHTSDRG(",DR=".01///BARBITURATES" D ^DIE K DA,DR,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

 S DIK="^AMHPSUIC(",DIK(1)=".21^AEX" D ENALL^DIK

 S X=0 F  S X=$O(^AMHREC(X)) Q:X'=+X  I $P($G(^AMHREC(X,14)),U)="U" S $P(^AMHREC(X,14),U)="UAS" W "."

 S X=$$ADD^XPDMENU("AMH M MANAGER UTILITIES","AMH BACKLOAD CDMIS DATA","BLCD")

 I 'X W "Attempt to add cdmis backload option failed.." H 3

 S X=$$ADD^XPDMENU("AMH M PATIENT LISTINGS","AMH RPT TIME IN GRP","TSG")

 I 'X W "Attempt to add time in group report option failed.." H 3

 D ^AMH30P3B

 Q

 ;;

 ;

 ;;

 ;

AMH30P3   ; IHS/CMI/LAB - POST INIT BH ;   [ 09/14/04  6:55 AM ]

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

 +2       ;

 +3       ;LORI -SEND OUT LISTER ITEMS

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       SET DA=$ORDER(^AMHTSDRG("B","BARBITUATES",0))

 +15       IF DA

               SET DIE="^AMHTSDRG("

               SET DR=".01///BARBITURATES"

               DO ^DIE

               KILL DA,DR,DIE

 +16       DO ^XBFMK

 +17       SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

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

 +18       FOR DA=1:1:200

               SET DIK="^AMHSORT("

               DO ^DIK

 +19       QUIT 

POST      ;EP

 +1        SET DIK="^AMHPSUIC("

           SET DIK(1)=".21^AEX"

           DO ENALL^DIK

 +2        SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

               IF $PIECE($GET(^AMHREC(X,14)),U)="U"

                   SET $PIECE(^AMHREC(X,14),U)="UAS"

                   WRITE "."

 +3        SET X=$$ADD^XPDMENU("AMH M MANAGER UTILITIES","AMH BACKLOAD CDMIS DATA","BLCD")

 +4        IF 'X

               WRITE "Attempt to add cdmis backload option failed.."

               HANG 3

 +5        SET X=$$ADD^XPDMENU("AMH M PATIENT LISTINGS","AMH RPT TIME IN GRP","TSG")

 +6        IF 'X

               WRITE "Attempt to add time in group report option failed.."

               HANG 3

 +7        DO ^AMH30P3B

 +8        QUIT 

 +9       ;;

 +10      ;

 +11      ;;

 +12      ;