AMH30P4.m

AMH30P4 ; IHS/CMI/LAB - POST INIT BH ;   [ 01/02/05  3:20 PM ]

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

 ;

 ;LORI -SEND OUT LISTER ITEMS

ENV ;EP 

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

 F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0

 Q

 ;

PRE ;

 I $D(^DD(9002011.65,.24,0)) S AMHX=0 F  S AMHX=$O(^AMHPSUIC(AMHX)) Q:AMHX'=+AMHX  S DA=AMHX,DIE="^AMHPSUIC(",DR="9901///1" D ^DIE  ;DON'T CONVERT A SECOND TIME

 D ^XBFMK

 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(^AMHTACT("B",14,0)) I DA S DIE="^AMHTACT(",DR=".08///@" D ^DIE K DIE,DA,DR

 S DA=$O(^AMHTACT("B",32,0)) I DA S DIE="^AMHTACT(",DR=".03///A" D ^DIE K DIE,DA,DR

 S DA=$O(^AMHTACT("B",66,0)) I DA S DIE="^AMHTACT(",DR=".03///A" D ^DIE K DIE,DA,DR

 S DA=$O(^AMHTACT("B",47,0)) I DA S DIE="^AMHTACT(",DR=".09///@" 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 DA=$O(^AMHPROBC("B",9.1,0))

 I DA S DIE="^AMHPROBC(",DR=".03///PSYCHOSOCIAL PROBLEMS" D ^DIE

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

 I DA S DIE="^AMHPROBC(",DR=".03///PSYCHOSOCIAL PROBLEMS" D ^DIE

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

 I DA S DIE="^AMHPROBC(",DR=".03///PSYCHOSOCIAL PROBLEMS" D ^DIE

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

 I DA S DIE="^AMHPROBC(",DR=".03///PSYCHOSOCIAL PROBLEMS" D ^DIE

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

 I DA S DIE="^AMHPROBC(",DR=".03///SCREENING" D ^DIE

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

 I DA,$D(^AMHPROBC("B",46.3)) S DIE="^AMHPROB(",DR=".03///46.3" D ^DIE

 S DA=0,AMHX=0 F  S AMHX=$O(^AMHPROB("B",780.59,AMHX)) Q:AMHX'=+AMHX  S DA=AMHX,DIE="^AMHPROB(",DR=".14///@" 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

 F DA=1:1:50 S DIK="^AMHDTER(" D ^DIK

 F DA=1:1:10 S DIK="^AMHRECD(" D ^DIK

 F DA=1:1:500 S DIK="^AMHTPCAD(" D ^DIK

 ;STORE DRUG DATA FROM SUICIDE FORMS

 K ^XTMP("AMH30P4")

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

 .Q:$P($G(^AMHPSUIC(X,99)),U)  ;ALREADY CONVERTED

 .S Y=0 F  S Y=$O(^AMHPSUIC(X,11,Y)) Q:Y'=+Y  D

 ..S Z=0 F  S Z=$O(^AMHPSUIC(X,11,Y,11,Z)) Q:Z'=+Z  D

 ...S D=$P(^AMHPSUIC(X,11,Y,11,Z,0),U) I D S ^XTMP("AMH30P4","OVERDOSE DRUGS",X,Y,Z)=$P($G(^AMHTSDRG(D,0)),U)

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

 .Q:$P($G(^AMHPSUIC(X,99)),U)  ;ALREADY CONVERTED

 .S Y=0 F  S Y=$O(^AMHPSUIC(X,12,Y)) Q:Y'=+Y  D

 ..S Z=0 F  S Z=$O(^AMHPSUIC(X,12,Y,11,Z)) Q:Z'=+Z  D

 ...S D=$P(^AMHPSUIC(X,12,Y,11,Z,0),U) I D S ^XTMP("AMH30P4","SUBSTANCE DRUGS",X,Y,Z)=$P($G(^AMHTSDRG(D,0)),U)

 ...Q

 F DA=1:1:500 S DIK="^AMHTSDRG(" D ^DIK

 S DA=$O(^APCHSCTL("B","MENTAL HEALTH/SOCIAL SERVICES",0)) I DA S DIE="^APCHSCTL(",DR=".01///BEHAVIORAL HEALTH" D ^DIE

 S DA=$O(^AMHTACT("B",77,0)) I DA S DIE="^AMHTACT(",DR=".09///1" D ^DIE

 S DA=$O(^AMHTSSU("B","NON-PRESCRIBED OPIATES (E.G. H",0)) I DA S DIE="^AMHTSSU(",DR=".01///NON-PRESCRIBED OPIATES (HEROIN)" D ^DIE

 S DA=$O(^AMHTSDRG("B","NON-PRESCRIBED OPIATES (E.G. H",0)) I DA S DIE="^AMHTSDRG(",DR=".01///NON-PRESCRIBED OPIATES (HEROIN)" D ^DIE

 D ^XBFMK

 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

 S X=$$ADD^XPDMENU("AMH DE UPDATE TREATMENT PLANS","AMH TP LIST ALL TPS","ATP")

 I 'X W "Attempt to add all treatment plan report option failed.." H 3

 S X=$$ADD^XPDMENU("AMH M DATA ENTRY MENU","AMH GROUP ENTRY","GP",30)

 I 'X W "Attempt to add GROUP ENTRY option failed.." H 3

 ;convert suicide form data

 S DA=$O(^AMHTACT("B",47,0)) I DA S DIE="^AMHTACT(",DR=".09///@" D ^DIE K DIE,DA,DR

 D ^AMH30P4D

 D ^AMH30P4C

 K ^XTMP("AMH30P4")

 D ^XBFMK K DLAYGO,DIADD

 ;Q:$D(^APCDLINK("B","BEHAVIORAL HEALTH"))  ;already exists

 S DA=$O(^APCDLINK("B","BEHAVIORAL HEALTH",0))

 I 'DA K DD,DO S DIC="^APCDLINK(",DIC(0)="LE",DLAYGO=9001002,X="BEHAVIORAL HEALTH" D FILE^DICN K DLAYGO,DD,DIC,DO S DA=+Y

 S DR="1///S:$D(X) AMHX=X S X=""AMHPCCL"" X ^%ZOSF(""TEST"") S:$D(AMHX) X=AMHX K AMHX I $T D MRG^AMHPCCL"_";3///S:$D(X) AMHX=X S X=""AMHPCCL"" X ^%ZOSF(""TEST"") S:$D(AMHX) X=AMHX K AMHX I $T D DEL^AMHPCCL"

 S DIE="^APCDLINK("

 D ^DIE K DIE,DR,DA

 D ^AMH30P4B

 Q

 ;;

 ;

 ;;

 ;

AMH30P4   ; IHS/CMI/LAB - POST INIT BH ;   [ 01/02/05  3:20 PM ]

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

 +2       ;

 +3       ;LORI -SEND OUT LISTER ITEMS

ENV       ;EP 

 +1        IF $GET(XPDENV)=1

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

 +2        FOR X="XPO1","XPZ1","XPZ2","XPI1"

               SET XPDDIQ(X)=0

 +3        QUIT 

 +4       ;

PRE       ;

 +1       ;DON'T CONVERT A SECOND TIME

           IF $DATA(^DD(9002011.65,.24,0))

               SET AMHX=0

               FOR 

                   SET AMHX=$ORDER(^AMHPSUIC(AMHX))

                   IF AMHX'=+AMHX

                       QUIT 

                   SET DA=AMHX

                   SET DIE="^AMHPSUIC("

                   SET DR="9901///1"

                   DO ^DIE

 +2        DO ^XBFMK

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

           SET DA=.13

           SET DA(1)=9002011.55

           DO ^DIK

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

           SET DA=.06

           SET DA(1)=9002011.51

           DO ^DIK

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

           SET DA=.17

           SET DA(1)=9002011

           DO ^DIK

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

           IF DA

               SET DIE="^AMHTACT("

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

               DO ^DIE

               KILL DIE,DA,DR

 +7        SET DA=$ORDER(^AMHTACT("B",14,0))

           IF DA

               SET DIE="^AMHTACT("

               SET DR=".08///@"

               DO ^DIE

               KILL DIE,DA,DR

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

           IF DA

               SET DIE="^AMHTACT("

               SET DR=".03///A"

               DO ^DIE

               KILL DIE,DA,DR

 +9        SET DA=$ORDER(^AMHTACT("B",66,0))

           IF DA

               SET DIE="^AMHTACT("

               SET DR=".03///A"

               DO ^DIE

               KILL DIE,DA,DR

 +10       SET DA=$ORDER(^AMHTACT("B",47,0))

           IF DA

               SET DIE="^AMHTACT("

               SET DR=".09///@"

               DO ^DIE

               KILL DIE,DA,DR

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

 +12       IF DA

               SET DIE="^AMHPROB("

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

               DO ^DIE

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

 +14       IF DA

               SET DIE="^AMHPROBC("

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

               DO ^DIE

 +15       DO ^XBFMK

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

 +17       IF DA

               SET DIE="^AMHTSDRG("

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

               DO ^DIE

               KILL DA,DR,DIE

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

 +19       IF DA

               SET DIE="^AMHTSDRG("

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

               DO ^DIE

 +20       SET DA=$ORDER(^AMHTSDRG("B","BARBITUATES",0))

 +21       IF DA

               SET DIE="^AMHTSDRG("

               SET DR=".01///BARBITURATES"

               DO ^DIE

               KILL DA,DR,DIE

 +22       DO ^XBFMK

 +23       SET DA=$ORDER(^AMHPROBC("B",9.1,0))

 +24       IF DA

               SET DIE="^AMHPROBC("

               SET DR=".03///PSYCHOSOCIAL PROBLEMS"

               DO ^DIE

 +25       SET DA=$ORDER(^AMHPROBC("B",9.2,0))

 +26       IF DA

               SET DIE="^AMHPROBC("

               SET DR=".03///PSYCHOSOCIAL PROBLEMS"

               DO ^DIE

 +27       SET DA=$ORDER(^AMHPROBC("B",21.1,0))

 +28       IF DA

               SET DIE="^AMHPROBC("

               SET DR=".03///PSYCHOSOCIAL PROBLEMS"

               DO ^DIE

 +29       SET DA=$ORDER(^AMHPROBC("B",37.1,0))

 +30       IF DA

               SET DIE="^AMHPROBC("

               SET DR=".03///PSYCHOSOCIAL PROBLEMS"

               DO ^DIE

 +31       SET DA=$ORDER(^AMHPROBC("B",29.2,0))

 +32       IF DA

               SET DIE="^AMHPROBC("

               SET DR=".03///SCREENING"

               DO ^DIE

 +33       SET DA=$ORDER(^AMHPROB("B",46.3,0))

 +34       IF DA

               IF $DATA(^AMHPROBC("B",46.3))

                   SET DIE="^AMHPROB("

                   SET DR=".03///46.3"

                   DO ^DIE

 +35       SET DA=0

           SET AMHX=0

           FOR 

               SET AMHX=$ORDER(^AMHPROB("B",780.59,AMHX))

               IF AMHX'=+AMHX

                   QUIT 

               SET DA=AMHX

               SET DIE="^AMHPROB("

               SET DR=".14///@"

               DO ^DIE

 +36       DO ^XBFMK

 +37       SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

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

 +38       FOR DA=1:1:200

               SET DIK="^AMHSORT("

               DO ^DIK

 +39       FOR DA=1:1:50

               SET DIK="^AMHDTER("

               DO ^DIK

 +40       FOR DA=1:1:10

               SET DIK="^AMHRECD("

               DO ^DIK

 +41       FOR DA=1:1:500

               SET DIK="^AMHTPCAD("

               DO ^DIK

 +42      ;STORE DRUG DATA FROM SUICIDE FORMS

 +43       KILL ^XTMP("AMH30P4")

 +44       SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +45      ;ALREADY CONVERTED

                   IF $PIECE($GET(^AMHPSUIC(X,99)),U)

                       QUIT 

 +46               SET Y=0

                   FOR 

                       SET Y=$ORDER(^AMHPSUIC(X,11,Y))

                       IF Y'=+Y

                           QUIT 

                       Begin DoDot:2

 +47                       SET Z=0

                           FOR 

                               SET Z=$ORDER(^AMHPSUIC(X,11,Y,11,Z))

                               IF Z'=+Z

                                   QUIT 

                               Begin DoDot:3

 +48                               SET D=$PIECE(^AMHPSUIC(X,11,Y,11,Z,0),U)

                                   IF D

                                       SET ^XTMP("AMH30P4","OVERDOSE DRUGS",X,Y,Z)=$PIECE($GET(^AMHTSDRG(D,0)),U)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +49       SET X=0

           FOR 

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

               IF X'=+X

                   QUIT 

               Begin DoDot:1

 +50      ;ALREADY CONVERTED

                   IF $PIECE($GET(^AMHPSUIC(X,99)),U)

                       QUIT 

 +51               SET Y=0

                   FOR 

                       SET Y=$ORDER(^AMHPSUIC(X,12,Y))

                       IF Y'=+Y

                           QUIT 

                       Begin DoDot:2

 +52                       SET Z=0

                           FOR 

                               SET Z=$ORDER(^AMHPSUIC(X,12,Y,11,Z))

                               IF Z'=+Z

                                   QUIT 

                               Begin DoDot:3

 +53                               SET D=$PIECE(^AMHPSUIC(X,12,Y,11,Z,0),U)

                                   IF D

                                       SET ^XTMP("AMH30P4","SUBSTANCE DRUGS",X,Y,Z)=$PIECE($GET(^AMHTSDRG(D,0)),U)

 +54                               QUIT 

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +55       FOR DA=1:1:500

               SET DIK="^AMHTSDRG("

               DO ^DIK

 +56       SET DA=$ORDER(^APCHSCTL("B","MENTAL HEALTH/SOCIAL SERVICES",0))

           IF DA

               SET DIE="^APCHSCTL("

               SET DR=".01///BEHAVIORAL HEALTH"

               DO ^DIE

 +57       SET DA=$ORDER(^AMHTACT("B",77,0))

           IF DA

               SET DIE="^AMHTACT("

               SET DR=".09///1"

               DO ^DIE

 +58       SET DA=$ORDER(^AMHTSSU("B","NON-PRESCRIBED OPIATES (E.G. H",0))

           IF DA

               SET DIE="^AMHTSSU("

               SET DR=".01///NON-PRESCRIBED OPIATES (HEROIN)"

               DO ^DIE

 +59       SET DA=$ORDER(^AMHTSDRG("B","NON-PRESCRIBED OPIATES (E.G. H",0))

           IF DA

               SET DIE="^AMHTSDRG("

               SET DR=".01///NON-PRESCRIBED OPIATES (HEROIN)"

               DO ^DIE

 +60       DO ^XBFMK

 +61       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        SET X=$$ADD^XPDMENU("AMH DE UPDATE TREATMENT PLANS","AMH TP LIST ALL TPS","ATP")

 +8        IF 'X

               WRITE "Attempt to add all treatment plan report option failed.."

               HANG 3

 +9        SET X=$$ADD^XPDMENU("AMH M DATA ENTRY MENU","AMH GROUP ENTRY","GP",30)

 +10       IF 'X

               WRITE "Attempt to add GROUP ENTRY option failed.."

               HANG 3

 +11      ;convert suicide form data

 +12       SET DA=$ORDER(^AMHTACT("B",47,0))

           IF DA

               SET DIE="^AMHTACT("

               SET DR=".09///@"

               DO ^DIE

               KILL DIE,DA,DR

 +13       DO ^AMH30P4D

 +14       DO ^AMH30P4C

 +15       KILL ^XTMP("AMH30P4")

 +16       DO ^XBFMK

           KILL DLAYGO,DIADD

 +17      ;Q:$D(^APCDLINK("B","BEHAVIORAL HEALTH"))  ;already exists

 +18       SET DA=$ORDER(^APCDLINK("B","BEHAVIORAL HEALTH",0))

 +19       IF 'DA

               KILL DD,DO

               SET DIC="^APCDLINK("

               SET DIC(0)="LE"

               SET DLAYGO=9001002

               SET X="BEHAVIORAL HEALTH"

               DO FILE^DICN

               KILL DLAYGO,DD,DIC,DO

               SET DA=+Y

 +20       SET DR="1///S:$D(X) AMHX=X S X=""AMHPCCL"" X ^%ZOSF(""TEST"") S:$D(AMHX) X=AMHX K AMHX I $T D MRG^AMHPCCL"_";3///S:$D(X) AMHX=X S X=""AMHPCCL"" X ^%ZOSF(""TEST"") S:$D(AMHX) X=AMHX K AMHX I $T D DEL^AMHPCCL"

 +21       SET DIE="^APCDLINK("

 +22       DO ^DIE

           KILL DIE,DR,DA

 +23       DO ^AMH30P4B

 +24       QUIT 

 +25      ;;

 +26      ;

 +27      ;;

 +28      ;