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 ;
