AMHCDBL ; IHS/CMI/LAB - backload pcc visits ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;backfill BH with CDMIS Data
;
EP ;
I '$D(^AMHTCOMP("B","PREVENTION")) D
.S X="PREVENTION",DIC="^AMHTCOMP(",DIADD=1,DLAYGO=9002013.7,DIC(0)="L",DIC("DR")="1////PRV;2////B;3////Y;4////PREVENTION" D FILE^DICN
.K DIADD,DLAYGO
.D ^XBFMK
.Q
START ;
I $$VERSION^XPDUTL("ACD")<4.1 W !!,"CDMIS IS NOT UP TO VERSION 4.1, CANNOT CONTINUE" D XIT Q
K ^TMP($J)
S DIFGLINE=1
W !!,"This routine is used to backload CDMIS data into the BH package."
W !!,"This option should be only by those sites that have discontinued"
W !,"the use of the CDMIS module.",!
W !,"Only visits in a date range you specify will be transferred."
W !,"You should decide ahead of time how far back you want to go"
W !,"in backloading data. It might be wise to just backload the past"
W !,"1 or 2 years worth of data first and then decide if older data"
W !,"should be moved.",!!
CONT ;
S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
I 'Y G XIT
D ;date range
K AMHED,AMHBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date of CDMIS Visits to backload"
D ^DIR S:Y<1 AMHQUIT=1 G:Y<1 START S AMHBD=Y
K DIR S DIR(0)="DO^::EXP",DIR("A")="Enter Ending Date of CDMIS Visits to backload"
D ^DIR S:Y<1 AMHQUIT=1 G:Y<1 D S AMHED=Y
;
I AMHED<AMHBD D G D
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
W !,"Please enter the location to be used as a default for Prevention Activities."
S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("B")=$$VAL^XBDIQ1(9002013,DUZ(2),.28) D ^DIC
K DIC,DA
I Y=-1 D XIT Q
S AMHDLOC=+Y
W !,"Please enter the community to be used as a default for all records created."
S DIC="^AUTTCOM(",DIC(0)="AEMQ",DIC("B")=$$VAL^XBDIQ1(9002013,DUZ(2),.29) D ^DIC
K DIC,DA
I Y=-1 D XIT Q
S AMHDCOM=+Y
PCC ;
W !!,"These CDMIS visits do not need to pass to PCC because they are old visits."
S AMHPCCL=0,AMHLPCC=0
S DIR(0)="Y",DIR("A")="Should these visits also pass to PCC",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
I Y S AMHPCCL=1,AMHLPCC=1
PROC ;
W !!,"Please be patient while the conversion process takes place..."
W !,"Moving CDMIS Prevention Activities"
D CDPREV
W !,"Moving CDMIS visits"
D CDVISIT
W !!,"all done"
;S DA=DUZ(2),DR="1501///1",DIE="^AMHSITE(" D ^DIE
K ^TMP($J)
D EN^XBVK("AMH")
D ^XBFMK
K DIFGLINE
Q
CDVISIT ;
D ^AMHLEIN
S AMHBL=1,AMHCIN=0,AMHCRE=0,AMHCFU=0,AMHCIR=0,AMHCOT=0,AMHCTD=0
S APCDOVRR=1,AMHCDVS=0
S AMHIEN=0 F S AMHIEN=$O(^ACDVIS(AMHIEN)) Q:AMHIEN'=+AMHIEN D
.S AMHR0=$G(^ACDVIS(AMHIEN,0))
.Q:$D(^ACDVIS(AMHIEN,"BHCONV"))
.S ^ACDVIS(AMHIEN,"BHCONV")=""
.W "."
.Q:AMHR0=""
.S AMHDATE=$P(AMHR0,U,1)
.Q:AMHDATE<AMHBD
.Q:AMHDATE>AMHED
DE .;
.S AMHCOMP=$$VAL^XBDIQ1(9002172.1,AMHIEN,1),AMHCOMPI=$P(AMHR0,U,2)
.S AMHCOMPB=$O(^AMHTCOMP("B",AMHCOMP,0)) I AMHCOMPB="" W !,"Cannot map component: ",AMHCOMP," ",AMHIEN," Using Other" S AMHCOMP="OTHER",AMHCOMPB=$O(^AMHTCOMP("B","OTHER",0))
.S AMHCOMT=$$VAL^XBDIQ1(9002172.1,AMHIEN,5),AMHCOMTI=$P(AMHR0,U,7)
.S AMHPROV=$P(AMHR0,U,3)
.S AMHTC=$P(AMHR0,U,4)
.S AMHPAT=$P(AMHR0,U,5)
.;Q:AMHPAT=""
.S AMHLOC=$G(^ACDVIS(AMHIEN,"BWP")) I AMHLOC="" S AMHLOC=DUZ(2)
.I AMHTC="IN" S AMHACT=12 D IN S AMHCIN=AMHCIN+1 Q
.I AMHTC="RE" S AMHACT=12 D IN S AMHCRE=AMHCRE+1 Q
.I AMHTC="FU" S AMHACT=21 D IN S AMHCFU=AMHCFU+1 Q
.I AMHTC="IR" S AMHACT=25 D IN S AMHCIR=AMHCIR+1
.I AMHTC="OT" S AMHACT=48 D IN S AMHCOT=AMHCOT+1 Q
.I AMHTC="TD" S AMHACT=19 D TD^AMHCDBL1 S AMHCTD=AMHCTD+1 Q
.;I AMHTC="CS" S AMHACT="" D CS^AMHCDBL2
W !,"moved ",AMHCDVS," cdmis visits"
W !,AMHCIN," initial"
W !,AMHCRE," reopen"
W !,AMHCFU," follow up"
W !,AMHCIR," info/referral"
W !,AMHCOT," other"
W !,AMHCTD," trans/disc"
Q
IN ;
D IN^AMHCDBL1
Q
CDPREV ;
;move all entries from ACDPD using month/yr from .01 field and then date from .01 of multiple
;
S AMHCDPRC=0
S AMHIEN=0 F S AMHIEN=$O(^ACDPD(AMHIEN)) Q:AMHIEN'=+AMHIEN D
.W "."
.S AMHR0=$G(^ACDPD(AMHIEN,0))
.Q:AMHR0=""
.S AMHMY=$E($P(AMHR0,U),1,5)
.S AMHCOMP=$$VAL^XBDIQ1(9002170.7,AMHIEN,1)
.I AMHCOMP="" S AMHCOMP="OTHER",AMHCOMPB=$O(^AMHTCOMP("B","OTHER",0)) G C1
.S AMHCOMPB=$O(^AMHTCOMP("B",AMHCOMP,0)) I AMHCOMPB="" W !,"Cannot map component: ",AMHCOMP," ",AMHIEN," Using Other" S AMHCOMP="OTHER",AMHCOMPB=$O(^AMHTCOMP("B","OTHER",0))
C1 .S AMHCOMT=$$VAL^XBDIQ1(9002170.7,AMHIEN,2)
.S AMHLOC=$P(AMHR0,U,4)
.S AMHMIEN=0 F S AMHMIEN=$O(^ACDPD(AMHIEN,1,AMHMIEN)) Q:AMHMIEN'=+AMHMIEN D
..I $D(^ACDPD(AMHIEN,1,AMHMIEN,"BHCONV")) Q ;already moved
..S AMHMR0=^ACDPD(AMHIEN,1,AMHMIEN,0)
..S AMHDAY=$P(AMHMR0,U) I $L(AMHDAY)=1 S AMHDAY="0"_AMHDAY
..S AMHDATE=AMHMY_AMHDAY S X=AMHDATE,%DT="" D ^%DT I Y=-1 Q ;W !,"invalid date: ",AMHDATE," ien: ",AMHIEN," ",AMHMIEN Q
..I AMHDATE<AMHBD!(AMHDATE>AMHED) Q
..S AMHPRA=$P(AMHMR0,U,2) I AMHPRA="" W !,"NO prevention activity, skipping" Q
..S AMHPRA=$P(^ACDPREV(9002170.9,AMHPRA,0),U)
.. S X=AMHPRA,DIC(0)="M",DIC="^AMHTPA(" D ^DIC S AMHPRAB=+Y I AMHPRAB="" W !,"Could not map prevention activity: ",AMHPRA Q
.. K DIC D ^XBFMK
..S AMHTAR=$P(AMHMR0,U,4)
..S AMHNS=$P(AMHMR0,U,5)
..S AMHCAT=$P(AMHMR0,U,7) I AMHCAT S AMHCAT=$O(^ACDLOT(AMHCAT,0),U)
..S AMHCAT=$$TOC(AMHCAT)
..S AMHTIME=$P(AMHMR0,U,8) I AMHTIME="" W !,"no time on prevention.. skipping ",AMHIEN," ",AMHMIEN Q
..S AMHTIME=AMHTIME*60
..;create MHSS record
..K DIC S DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHDATE,DIC("DR")=".02///C;.03///^S X=DT;.19////"_DUZ_";.33////R;.28////"_DUZ_";.22///A;.21///^S X=DT"
..K DD,DO,D0 D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
..I Y=-1 W !!,$C(7),$C(7),"Error creating Behavioral Health Record!! Deleting Record.",! Q
..S AMHR=+Y,DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR
..S DA=AMHR,DR=".04////"_AMHLOC_";.05////"_AMHDCOM_";.06///37;.07///"_AMHCAT_";.09///"_AMHNS_";.12///"_AMHTIME_";.32///PR;1101///"_AMHCOMP_";1105///"_AMHCOMT_";1106///"_AMHTAR,DIE="^AMHREC(" D ^DIE
..I $D(Y) W !!,"error editing MHSS Record entry ",AMHIEN," ",AMHMIEN
..;now create provider
..S AMHIENP=0,AMHC=0 F S AMHIENP=$O(^ACDPD(AMHIEN,1,AMHMIEN,"PRV",AMHIENP)) Q:AMHIENP'=+AMHIENP D
...S Y=$P(^ACDPD(AMHIEN,1,AMHMIEN,"PRV",AMHIENP,0),U)
...S AMHC=AMHC+1
...S AMHPS=$S(AMHC=1:"P",1:"S")
...S X=+Y,DIC("DR")=".03////"_AMHR_";.04///"_AMHPS,DIC="^AMHRPROV(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.02 K DD,DO D FILE^DICN K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
...I Y=-1 W !!,"Creating Primary Provider entry failed!!!",$C(7),$C(7) H 2
...D ^XBFMK
..;now create POV
..S Y=$O(^AMHPROB("B",99,0))
..S X=+Y,DIC("DR")=".03////"_AMHR_";.04///PREVENTION ACTIVITY: "_AMHPRA,DIC="^AMHRPRO(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.01 K DD,DO D FILE^DICN K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
..I Y=-1 W !!,"Creating POV entry failed!!!",$C(7),$C(7) H 2
..D ^XBFMK
..;now create prevention activity
..S X=AMHPRAB,DIC("DR")=".03////"_AMHR,DIC="^AMHRPA(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.09 K DD,DO D FILE^DICN K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
..I Y=-1 W !!,"Creating PREVENTION ACTIVITY entry failed!!!",$C(7),$C(7) H 2
..D ^XBFMK
..S ^ACDPD(AMHIEN,1,AMHMIEN,"BHCONV")=""
..S AMHCDPRC=AMHCDPRC+1
W !!,"A total of ",AMHCDPRC," CDMIS prevention activities moved to BH."
Q
XIT ;
W !!,"ALL DONE",!
D EN^XBVK("AMH")
D ^XBFMK
Q
TOC(X) ;
I X="" Q 4
I X="SCHOOL" Q 6
I X="COMMUNITY FACILITY" Q 4
I X="CONTRACT PROGRAM" Q 4
I X="HOME" Q 5
I X="JAIL/COURTS" Q 14
I X="MEDICAL FACILITY" Q 3
I X="OTHER" Q 4
I X="OUTDOORS" Q 4
I X="PROGRAM FACILITY" Q 2
I X="REGIONAL TRTMNT CTR" Q 11
Q 4
PROBCONV ;
;S X=0 F S X=$O(AMHPROB(X)) Q:X'=+X S %=$$PCONV($P(AMHPROB(X),U,3)),$P(AMHPROB(X),U,4)=%,$P(AMHPROB(X),U,5)=$O(^AMHPROB("B",%,0))
Q
PCCLINK ;EP
Q:AMHPAT=""
S AMHPTYPE="C"
Q:'$P(^AMHTACT($P(^AMHREC(AMHR,0),U,6),0),U,4)
S DFN=AMHPAT
S AMHACTN=1
;check for pcc visit on this date
Q:$$VIS(AMHPAT,AMHDATE) ;quit if already an alcohol clinic visit on this date
D PCCLINK^AMHLE2
S V=$P(^AMHREC(AMHR,0),U,16)
I V K ^AUPNVSIT("ABILL",DT,V),^AUPNVSIT("ADWO",DT,V)
Q
VIS(P,D) ;
NEW X,Y,G
S G=0
S X=9999999-AMHDATE,Y=0 F S X=$O(^AUPNVSIT("AA",P,X)) Q:$P(X,".")>AMHDATE!(X="") D
.S Y=0 F S Y=$O(^AUPNVSIT("AA",P,X,Y)) Q:Y'=+Y I $$CLINIC^APCLV(Y,"C")=43 S G=1
.Q
Q G
AMHCDBL ; IHS/CMI/LAB - backload pcc visits ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;backfill BH with CDMIS Data
+4 ;
EP ;
+1 IF '$DATA(^AMHTCOMP("B","PREVENTION"))
Begin DoDot:1
+2 SET X="PREVENTION"
SET DIC="^AMHTCOMP("
SET DIADD=1
SET DLAYGO=9002013.7
SET DIC(0)="L"
SET DIC("DR")="1////PRV;2////B;3////Y;4////PREVENTION"
DO FILE^DICN
+3 KILL DIADD,DLAYGO
+4 DO ^XBFMK
+5 QUIT
End DoDot:1
START ;
+1 IF $$VERSION^XPDUTL("ACD")<4.1
WRITE !!,"CDMIS IS NOT UP TO VERSION 4.1, CANNOT CONTINUE"
DO XIT
QUIT
+2 KILL ^TMP($JOB)
+3 SET DIFGLINE=1
+4 WRITE !!,"This routine is used to backload CDMIS data into the BH package."
+5 WRITE !!,"This option should be only by those sites that have discontinued"
+6 WRITE !,"the use of the CDMIS module.",!
+7 WRITE !,"Only visits in a date range you specify will be transferred."
+8 WRITE !,"You should decide ahead of time how far back you want to go"
+9 WRITE !,"in backloading data. It might be wise to just backload the past"
+10 WRITE !,"1 or 2 years worth of data first and then decide if older data"
+11 WRITE !,"should be moved.",!!
CONT ;
+1 SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF 'Y
GOTO XIT
D ;date range
+1 KILL AMHED,AMHBD
+2 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Date of CDMIS Visits to backload"
+3 DO ^DIR
IF Y<1
SET AMHQUIT=1
IF Y<1
GOTO START
SET AMHBD=Y
+4 KILL DIR
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Ending Date of CDMIS Visits to backload"
+5 DO ^DIR
IF Y<1
SET AMHQUIT=1
IF Y<1
GOTO D
SET AMHED=Y
+6 ;
+7 IF AMHED<AMHBD
Begin DoDot:1
+8 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO D
+9 WRITE !,"Please enter the location to be used as a default for Prevention Activities."
+10 SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
SET DIC("B")=$$VAL^XBDIQ1(9002013,DUZ(2),.28)
DO ^DIC
+11 KILL DIC,DA
+12 IF Y=-1
DO XIT
QUIT
+13 SET AMHDLOC=+Y
+14 WRITE !,"Please enter the community to be used as a default for all records created."
+15 SET DIC="^AUTTCOM("
SET DIC(0)="AEMQ"
SET DIC("B")=$$VAL^XBDIQ1(9002013,DUZ(2),.29)
DO ^DIC
+16 KILL DIC,DA
+17 IF Y=-1
DO XIT
QUIT
+18 SET AMHDCOM=+Y
PCC ;
+1 WRITE !!,"These CDMIS visits do not need to pass to PCC because they are old visits."
+2 SET AMHPCCL=0
SET AMHLPCC=0
+3 SET DIR(0)="Y"
SET DIR("A")="Should these visits also pass to PCC"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
GOTO XIT
+5 IF Y
SET AMHPCCL=1
SET AMHLPCC=1
PROC ;
+1 WRITE !!,"Please be patient while the conversion process takes place..."
+2 WRITE !,"Moving CDMIS Prevention Activities"
+3 DO CDPREV
+4 WRITE !,"Moving CDMIS visits"
+5 DO CDVISIT
+6 WRITE !!,"all done"
+7 ;S DA=DUZ(2),DR="1501///1",DIE="^AMHSITE(" D ^DIE
+8 KILL ^TMP($JOB)
+9 DO EN^XBVK("AMH")
+10 DO ^XBFMK
+11 KILL DIFGLINE
+12 QUIT
CDVISIT ;
+1 DO ^AMHLEIN
+2 SET AMHBL=1
SET AMHCIN=0
SET AMHCRE=0
SET AMHCFU=0
SET AMHCIR=0
SET AMHCOT=0
SET AMHCTD=0
+3 SET APCDOVRR=1
SET AMHCDVS=0
+4 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^ACDVIS(AMHIEN))
IF AMHIEN'=+AMHIEN
QUIT
Begin DoDot:1
+5 SET AMHR0=$GET(^ACDVIS(AMHIEN,0))
+6 IF $DATA(^ACDVIS(AMHIEN,"BHCONV"))
QUIT
+7 SET ^ACDVIS(AMHIEN,"BHCONV")=""
+8 WRITE "."
+9 IF AMHR0=""
QUIT
+10 SET AMHDATE=$PIECE(AMHR0,U,1)
+11 IF AMHDATE<AMHBD
QUIT
+12 IF AMHDATE>AMHED
QUIT
DE ;
+1 SET AMHCOMP=$$VAL^XBDIQ1(9002172.1,AMHIEN,1)
SET AMHCOMPI=$PIECE(AMHR0,U,2)
+2 SET AMHCOMPB=$ORDER(^AMHTCOMP("B",AMHCOMP,0))
IF AMHCOMPB=""
WRITE !,"Cannot map component: ",AMHCOMP," ",AMHIEN," Using Other"
SET AMHCOMP="OTHER"
SET AMHCOMPB=$ORDER(^AMHTCOMP("B","OTHER",0))
+3 SET AMHCOMT=$$VAL^XBDIQ1(9002172.1,AMHIEN,5)
SET AMHCOMTI=$PIECE(AMHR0,U,7)
+4 SET AMHPROV=$PIECE(AMHR0,U,3)
+5 SET AMHTC=$PIECE(AMHR0,U,4)
+6 SET AMHPAT=$PIECE(AMHR0,U,5)
+7 ;Q:AMHPAT=""
+8 SET AMHLOC=$GET(^ACDVIS(AMHIEN,"BWP"))
IF AMHLOC=""
SET AMHLOC=DUZ(2)
+9 IF AMHTC="IN"
SET AMHACT=12
DO IN
SET AMHCIN=AMHCIN+1
QUIT
+10 IF AMHTC="RE"
SET AMHACT=12
DO IN
SET AMHCRE=AMHCRE+1
QUIT
+11 IF AMHTC="FU"
SET AMHACT=21
DO IN
SET AMHCFU=AMHCFU+1
QUIT
+12 IF AMHTC="IR"
SET AMHACT=25
DO IN
SET AMHCIR=AMHCIR+1
+13 IF AMHTC="OT"
SET AMHACT=48
DO IN
SET AMHCOT=AMHCOT+1
QUIT
+14 IF AMHTC="TD"
SET AMHACT=19
DO TD^AMHCDBL1
SET AMHCTD=AMHCTD+1
QUIT
+15 ;I AMHTC="CS" S AMHACT="" D CS^AMHCDBL2
End DoDot:1
+16 WRITE !,"moved ",AMHCDVS," cdmis visits"
+17 WRITE !,AMHCIN," initial"
+18 WRITE !,AMHCRE," reopen"
+19 WRITE !,AMHCFU," follow up"
+20 WRITE !,AMHCIR," info/referral"
+21 WRITE !,AMHCOT," other"
+22 WRITE !,AMHCTD," trans/disc"
+23 QUIT
IN ;
+1 DO IN^AMHCDBL1
+2 QUIT
CDPREV ;
+1 ;move all entries from ACDPD using month/yr from .01 field and then date from .01 of multiple
+2 ;
+3 SET AMHCDPRC=0
+4 SET AMHIEN=0
FOR
SET AMHIEN=$ORDER(^ACDPD(AMHIEN))
IF AMHIEN'=+AMHIEN
QUIT
Begin DoDot:1
+5 WRITE "."
+6 SET AMHR0=$GET(^ACDPD(AMHIEN,0))
+7 IF AMHR0=""
QUIT
+8 SET AMHMY=$EXTRACT($PIECE(AMHR0,U),1,5)
+9 SET AMHCOMP=$$VAL^XBDIQ1(9002170.7,AMHIEN,1)
+10 IF AMHCOMP=""
SET AMHCOMP="OTHER"
SET AMHCOMPB=$ORDER(^AMHTCOMP("B","OTHER",0))
GOTO C1
+11 SET AMHCOMPB=$ORDER(^AMHTCOMP("B",AMHCOMP,0))
IF AMHCOMPB=""
WRITE !,"Cannot map component: ",AMHCOMP," ",AMHIEN," Using Other"
SET AMHCOMP="OTHER"
SET AMHCOMPB=$ORDER(^AMHTCOMP("B","OTHER",0))
C1 SET AMHCOMT=$$VAL^XBDIQ1(9002170.7,AMHIEN,2)
+1 SET AMHLOC=$PIECE(AMHR0,U,4)
+2 SET AMHMIEN=0
FOR
SET AMHMIEN=$ORDER(^ACDPD(AMHIEN,1,AMHMIEN))
IF AMHMIEN'=+AMHMIEN
QUIT
Begin DoDot:2
+3 ;already moved
IF $DATA(^ACDPD(AMHIEN,1,AMHMIEN,"BHCONV"))
QUIT
+4 SET AMHMR0=^ACDPD(AMHIEN,1,AMHMIEN,0)
+5 SET AMHDAY=$PIECE(AMHMR0,U)
IF $LENGTH(AMHDAY)=1
SET AMHDAY="0"_AMHDAY
+6 ;W !,"invalid date: ",AMHDATE," ien: ",AMHIEN," ",AMHMIEN Q
SET AMHDATE=AMHMY_AMHDAY
SET X=AMHDATE
SET %DT=""
DO ^%DT
IF Y=-1
QUIT
+7 IF AMHDATE<AMHBD!(AMHDATE>AMHED)
QUIT
+8 SET AMHPRA=$PIECE(AMHMR0,U,2)
IF AMHPRA=""
WRITE !,"NO prevention activity, skipping"
QUIT
+9 SET AMHPRA=$PIECE(^ACDPREV(9002170.9,AMHPRA,0),U)
+10 SET X=AMHPRA
SET DIC(0)="M"
SET DIC="^AMHTPA("
DO ^DIC
SET AMHPRAB=+Y
IF AMHPRAB=""
WRITE !,"Could not map prevention activity: ",AMHPRA
QUIT
+11 KILL DIC
DO ^XBFMK
+12 SET AMHTAR=$PIECE(AMHMR0,U,4)
+13 SET AMHNS=$PIECE(AMHMR0,U,5)
+14 SET AMHCAT=$PIECE(AMHMR0,U,7)
IF AMHCAT
SET AMHCAT=$ORDER(^ACDLOT(AMHCAT,0),U)
+15 SET AMHCAT=$$TOC(AMHCAT)
+16 SET AMHTIME=$PIECE(AMHMR0,U,8)
IF AMHTIME=""
WRITE !,"no time on prevention.. skipping ",AMHIEN," ",AMHMIEN
QUIT
+17 SET AMHTIME=AMHTIME*60
+18 ;create MHSS record
+19 KILL DIC
SET DIC(0)="EL"
SET DIC="^AMHREC("
SET DLAYGO=9002011
SET DIADD=1
SET X=AMHDATE
SET DIC("DR")=".02///C;.03///^S X=DT;.19////"_DUZ_";.33////R;.28////"_DUZ_";.22///A;.21///^S X=DT"
+20 KILL DD,DO,D0
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+21 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"Error creating Behavioral Health Record!! Deleting Record.",!
QUIT
+22 SET AMHR=+Y
SET DIE="^AMHREC("
SET DA=AMHR
SET DR="5100///NOW"
SET DR(2,9002011.5101)=".02////^S X=DUZ"
DO ^DIE
KILL DIE,DA,DR
+23 SET DA=AMHR
SET DR=".04////"_AMHLOC_";.05////"_AMHDCOM_";.06///37;.07///"_AMHCAT_";.09///"_AMHNS_";.12///"_AMHTIME_";.32///PR;1101///"_AMHCOMP_";1105///"_AMHCOMT_";1106///"_AMHTAR
SET DIE="^AMHREC("
DO ^DIE
+24 IF $DATA(Y)
WRITE !!,"error editing MHSS Record entry ",AMHIEN," ",AMHMIEN
+25 ;now create provider
+26 SET AMHIENP=0
SET AMHC=0
FOR
SET AMHIENP=$ORDER(^ACDPD(AMHIEN,1,AMHMIEN,"PRV",AMHIENP))
IF AMHIENP'=+AMHIENP
QUIT
Begin DoDot:3
+27 SET Y=$PIECE(^ACDPD(AMHIEN,1,AMHMIEN,"PRV",AMHIENP,0),U)
+28 SET AMHC=AMHC+1
+29 SET AMHPS=$SELECT(AMHC=1:"P",1:"S")
+30 SET X=+Y
SET DIC("DR")=".03////"_AMHR_";.04///"_AMHPS
SET DIC="^AMHRPROV("
SET DIC(0)="MLQ"
SET DIADD=1
SET DLAYGO=9002011.02
KILL DD,DO
DO FILE^DICN
KILL DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
+31 IF Y=-1
WRITE !!,"Creating Primary Provider entry failed!!!",$CHAR(7),$CHAR(7)
HANG 2
+32 DO ^XBFMK
End DoDot:3
+33 ;now create POV
+34 SET Y=$ORDER(^AMHPROB("B",99,0))
+35 SET X=+Y
SET DIC("DR")=".03////"_AMHR_";.04///PREVENTION ACTIVITY: "_AMHPRA
SET DIC="^AMHRPRO("
SET DIC(0)="MLQ"
SET DIADD=1
SET DLAYGO=9002011.01
KILL DD,DO
DO FILE^DICN
KILL DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
+36 IF Y=-1
WRITE !!,"Creating POV entry failed!!!",$CHAR(7),$CHAR(7)
HANG 2
+37 DO ^XBFMK
+38 ;now create prevention activity
+39 SET X=AMHPRAB
SET DIC("DR")=".03////"_AMHR
SET DIC="^AMHRPA("
SET DIC(0)="MLQ"
SET DIADD=1
SET DLAYGO=9002011.09
KILL DD,DO
DO FILE^DICN
KILL DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
+40 IF Y=-1
WRITE !!,"Creating PREVENTION ACTIVITY entry failed!!!",$CHAR(7),$CHAR(7)
HANG 2
+41 DO ^XBFMK
+42 SET ^ACDPD(AMHIEN,1,AMHMIEN,"BHCONV")=""
+43 SET AMHCDPRC=AMHCDPRC+1
End DoDot:2
End DoDot:1
+44 WRITE !!,"A total of ",AMHCDPRC," CDMIS prevention activities moved to BH."
+45 QUIT
XIT ;
+1 WRITE !!,"ALL DONE",!
+2 DO EN^XBVK("AMH")
+3 DO ^XBFMK
+4 QUIT
TOC(X) ;
+1 IF X=""
QUIT 4
+2 IF X="SCHOOL"
QUIT 6
+3 IF X="COMMUNITY FACILITY"
QUIT 4
+4 IF X="CONTRACT PROGRAM"
QUIT 4
+5 IF X="HOME"
QUIT 5
+6 IF X="JAIL/COURTS"
QUIT 14
+7 IF X="MEDICAL FACILITY"
QUIT 3
+8 IF X="OTHER"
QUIT 4
+9 IF X="OUTDOORS"
QUIT 4
+10 IF X="PROGRAM FACILITY"
QUIT 2
+11 IF X="REGIONAL TRTMNT CTR"
QUIT 11
+12 QUIT 4
PROBCONV ;
+1 ;S X=0 F S X=$O(AMHPROB(X)) Q:X'=+X S %=$$PCONV($P(AMHPROB(X),U,3)),$P(AMHPROB(X),U,4)=%,$P(AMHPROB(X),U,5)=$O(^AMHPROB("B",%,0))
+2 QUIT
PCCLINK ;EP
+1 IF AMHPAT=""
QUIT
+2 SET AMHPTYPE="C"
+3 IF '$PIECE(^AMHTACT($PIECE(^AMHREC(AMHR,0),U,6),0),U,4)
QUIT
+4 SET DFN=AMHPAT
+5 SET AMHACTN=1
+6 ;check for pcc visit on this date
+7 ;quit if already an alcohol clinic visit on this date
IF $$VIS(AMHPAT,AMHDATE)
QUIT
+8 DO PCCLINK^AMHLE2
+9 SET V=$PIECE(^AMHREC(AMHR,0),U,16)
+10 IF V
KILL ^AUPNVSIT("ABILL",DT,V),^AUPNVSIT("ADWO",DT,V)
+11 QUIT
VIS(P,D) ;
+1 NEW X,Y,G
+2 SET G=0
+3 SET X=9999999-AMHDATE
SET Y=0
FOR
SET X=$ORDER(^AUPNVSIT("AA",P,X))
IF $PIECE(X,".")>AMHDATE!(X="")
QUIT
Begin DoDot:1
+4 SET Y=0
FOR
SET Y=$ORDER(^AUPNVSIT("AA",P,X,Y))
IF Y'=+Y
QUIT
IF $$CLINIC^APCLV(Y,"C")=43
SET G=1
+5 QUIT
End DoDot:1
+6 QUIT G
