AMHCDBL2 ; IHS/CMI/LAB - backload pcc visits ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;backfill BH with CDMIS Data
CS ;EP
;create MHSS record first
S AMHCDST=0 F S AMHCDST=$O(^ACDCS("C",AMHIEN,AMHCDST)) Q:AMHCDST'=+AMHCDST D CS1
Q
CS1 ;
;get activity code from acdcs
S A=$P(^ACDCS(AMHCDST,0),U,2) I A="" W !,"Client service, no activity code. ",AMHIEN," ",$P(^ACDCS(AMHCDST,0),U,2)," is ien of activity" Q
S A=$P($G(^ACDSERV(A,0)),U,2) I A="" W !,"Client service, no activity code to map. ",AMHIEN," ",$P(^ACDCS(AMHCDST,0),U,2)," is ien of activity" Q
S AMHACT=$$ACONV(A)
I AMHACT="" W !,"No conversion of activity code on client service. ",AMHIEN," code is ",A Q
S AMHDAY=$P(^ACDCS(AMHCDST,0),U) I $L(AMHDAY)=1 S AMHDAY="0"_AMHDAY
S AMHDATE=$E(AMHDATE,1,5)_AMHDAY
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 AMHTIME=$P($G(^ACDCS(AMHCDST,0)),U,4) S AMHTIME=AMHTIME*60 I 'AMHTIME S AMHTIME=1
S DIE="^AMHREC(",DA=AMHR,DR=".04////"_AMHLOC_";.05////"_AMHDCOM_";.06///"_AMHACT_";.07///2;.08////"_AMHPAT_";.09///1;1101///"_AMHCOMP_";.12///"_AMHTIME_";.25///43;.32///"_AMHTC_";1105///"_AMHCOMT,DIE="^AMHREC(" D ^DIE
I $D(Y) W !!,"error editing MHSS Record entry ",AMHIEN," ",AMHMIEN
;get initial entry and file activity time and mhss staging tool entry, get problem for later use
S AMHSTR0=^ACDCS(AMHCDST,0)
K AMHPROB
;S X=$O(^TMP($J,"ACDCONV",AMHPAT,0)) Q:X="" S AMHPROB(1)=^TMP($J,"ACDCONV",AMHPAT,X)
;I X="" W !,"could not find problem code for this client service...SKIPPING ",AMHCDST,! Q
D GETVSITS,CHKFIN
I 'AMHY W !!,AMHIEN," ",AMHCDST," no initial to get problems." Q
S AMHINI=$O(^ACDIIF("C",AMHY,0))
S AMHSTR0=^ACDIIF(AMHINI,0)
S AMHPROB(1)=$P(AMHSTR0,U)_U_$P(^ACDPROB($P(AMHSTR0,U),0),U)_U_$P(^ACDPROB($P(AMHSTR0,U),0),U,2)
D PROBCONV
D ^XBFMK
;now create pov/provider
S X=AMHPROV,DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04///P",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
S AMHX=0 F S AMHX=$O(^ACDCS(AMHCDST,1,AMHX)) Q:AMHX'=+AMHX D
.S AMHPRV1=$P($G(^ACDCS(AMHCDST,1,AMHX,0)),U)
.Q:AMHPRV1=""
.S X=AMHPRV1,DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04///P",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 Secondary Prov entry for Client Service entry failed!!!"," ",$P(^VA(200,AMHPRV1,0),U)," ",AMHCDST H 2
S AMHX=0 F S AMHX=$O(AMHPROB(AMHX)) Q:AMHX'=+AMHX D
.S X=$P(AMHPROB(AMHX),U,5),DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04///"_$P(AMHPROB(AMHX),U,2),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
;S AMHACTN=1
;D PCCLINK^AMHCDBL
Q
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
GETVSITS ; EP - GET CDMIS VISITS FOR THIS CLIENT
K ^TMP("AMHCONV",$J,"VISITS")
S AMHVCNT=0,Y=0
F S Y=$O(^ACDVIS("D",AMHPAT,Y)) Q:'Y S X=^ACDVIS(Y,0) I $P($G(^("BWP")),U)=AMHLOC D
. S ^TMP("AMHCONV",$J,"VISITS",$P(X,U),Y)=X,AMHVCNT=AMHVCNT+1
. Q
Q
CHKFIN ; EP - CHECK FOR INITIAL CONTACT TYPE
S AMHX="",(AMHY,Y)=0
F S AMHX=$O(^TMP("AMHCONV",$J,"VISITS",AMHX)) Q:AMHX="" S Y=0 F S Y=$O(^TMP("AMHCONV",$J,"VISITS",AMHX,Y)) Q:'Y S X=^(Y) I $P(X,U,2)=AMHCOMPI,$P(X,U,7)=AMHCOMTI,$P(X,U,4)="IN" S AMHY=Y Q
Q
ACONV(P) ;
I P=7 Q 41
I P="ACU" Q 23
I P=19 Q 23
I P=6 Q 23
I P=11 Q 23
I P=23 Q 23
I P="ACO" Q 12
I P="DUI" Q 12
I P="AOT" Q 12
I P=14 Q 34
I P=16 Q 31
I P=15 Q 61
I P=13 Q 14
I P=3 Q 14
I P=4 Q 14
I P=2 Q 13
I P=1 Q 12
I P="MAS" Q 23
I P=20 Q 23
I P="MMO" Q 23
I P=10 Q 34
I P=12 Q 34
I P="PH" Q 26
I P=10 Q 23
I P=22 Q 23
I P=17 Q 25
I P=21 Q 23
I P=9 Q 14
I P=8 Q 14
I P=5 Q 82
I P=18 Q 38
I P="URS" Q 23
I P="CNOS1" Q 12
I P="CNOS2" Q 12
I P="CNOS3" Q 12
I P="MIA" Q 23
I P="OTH" Q 23
Q 23
PCONV(P) ;
I P=17 Q 89
I P=1 Q 29
I P=18 Q 94
I P=30 Q 43
I P=2 Q 30
I P=42 Q 23
I P=16 Q 3
I P=36 Q 42.2
I P=40 Q 44.2
I P=32 Q 43.2
I P=12 Q 59
I P=14 Q 79
I P=60 Q 312.31
I P=61 Q 26
I P=44 Q 302.6
I P=53 Q 80
I P=3 Q "305.90"
I P=13 Q 88
I P=11 Q 56
I P=15 Q 5
I P=55 Q 3
I P="MIA" Q 8
I P=37 Q 47
I P=41 Q 48
I P=33 Q 49
I P=19 Q 82
I P=20 Q 26
I P=34 Q 42.1
I P=38 Q 44.1
I P=49 Q 66
I P=35 Q 42.3
I P=39 Q 44.3
I P=31 Q 43.3
I P=43 Q 302.9
I P=50 Q 62
I P=10 Q 304.83
I P=9 Q 62
I P=47 Q 40
I P=48 Q 41
I P=46 Q 41
I P=45 Q 39
I P=29 Q "305.10"
Q 4
AMHCDBL2 ; IHS/CMI/LAB - backload pcc visits ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;backfill BH with CDMIS Data
CS ;EP
+1 ;create MHSS record first
+2 SET AMHCDST=0
FOR
SET AMHCDST=$ORDER(^ACDCS("C",AMHIEN,AMHCDST))
IF AMHCDST'=+AMHCDST
QUIT
DO CS1
+3 QUIT
CS1 ;
+1 ;get activity code from acdcs
+2 SET A=$PIECE(^ACDCS(AMHCDST,0),U,2)
IF A=""
WRITE !,"Client service, no activity code. ",AMHIEN," ",$PIECE(^ACDCS(AMHCDST,0),U,2)," is ien of activity"
QUIT
+3 SET A=$PIECE($GET(^ACDSERV(A,0)),U,2)
IF A=""
WRITE !,"Client service, no activity code to map. ",AMHIEN," ",$PIECE(^ACDCS(AMHCDST,0),U,2)," is ien of activity"
QUIT
+4 SET AMHACT=$$ACONV(A)
+5 IF AMHACT=""
WRITE !,"No conversion of activity code on client service. ",AMHIEN," code is ",A
QUIT
+6 SET AMHDAY=$PIECE(^ACDCS(AMHCDST,0),U)
IF $LENGTH(AMHDAY)=1
SET AMHDAY="0"_AMHDAY
+7 SET AMHDATE=$EXTRACT(AMHDATE,1,5)_AMHDAY
+8 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"
+9 KILL DD,DO,D0
DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+10 IF Y=-1
WRITE !!,$CHAR(7),$CHAR(7),"Error creating Behavioral Health Record!! Deleting Record.",!
QUIT
+11 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
+12 SET AMHTIME=$PIECE($GET(^ACDCS(AMHCDST,0)),U,4)
SET AMHTIME=AMHTIME*60
IF 'AMHTIME
SET AMHTIME=1
+13 SET DIE="^AMHREC("
SET DA=AMHR
SET DR=".04////"_AMHLOC_";.05////"_AMHDCOM_";.06///"_AMHACT_";.07///2;.08////"_AMHPAT_";.09///1;1101///"_AMHCOMP_";.12///"_AMHTIME_";.25///43;.32///"_AMHTC_";1105///"_AMHCOMT
SET DIE="^AMHREC("
DO ^DIE
+14 IF $DATA(Y)
WRITE !!,"error editing MHSS Record entry ",AMHIEN," ",AMHMIEN
+15 ;get initial entry and file activity time and mhss staging tool entry, get problem for later use
+16 SET AMHSTR0=^ACDCS(AMHCDST,0)
+17 KILL AMHPROB
+18 ;S X=$O(^TMP($J,"ACDCONV",AMHPAT,0)) Q:X="" S AMHPROB(1)=^TMP($J,"ACDCONV",AMHPAT,X)
+19 ;I X="" W !,"could not find problem code for this client service...SKIPPING ",AMHCDST,! Q
+20 DO GETVSITS
DO CHKFIN
+21 IF 'AMHY
WRITE !!,AMHIEN," ",AMHCDST," no initial to get problems."
QUIT
+22 SET AMHINI=$ORDER(^ACDIIF("C",AMHY,0))
+23 SET AMHSTR0=^ACDIIF(AMHINI,0)
+24 SET AMHPROB(1)=$PIECE(AMHSTR0,U)_U_$PIECE(^ACDPROB($PIECE(AMHSTR0,U),0),U)_U_$PIECE(^ACDPROB($PIECE(AMHSTR0,U),0),U,2)
+25 DO PROBCONV
+26 DO ^XBFMK
+27 ;now create pov/provider
+28 SET X=AMHPROV
SET DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04///P"
SET DIC="^AMHRPROV("
SET DIC(0)="MLQ"
SET DIADD=1
SET DLAYGO=9002011.02
+29 KILL DD,DO
DO FILE^DICN
KILL DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
+30 IF Y=-1
WRITE !!,"Creating Primary Provider entry failed!!!",$CHAR(7),$CHAR(7)
HANG 2
+31 DO ^XBFMK
+32 SET AMHX=0
FOR
SET AMHX=$ORDER(^ACDCS(AMHCDST,1,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+33 SET AMHPRV1=$PIECE($GET(^ACDCS(AMHCDST,1,AMHX,0)),U)
+34 IF AMHPRV1=""
QUIT
+35 SET X=AMHPRV1
SET DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04///P"
SET DIC="^AMHRPROV("
SET DIC(0)="MLQ"
SET DIADD=1
SET DLAYGO=9002011.02
+36 KILL DD,DO
DO FILE^DICN
KILL DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
+37 IF Y=-1
WRITE !!,"Creating Secondary Prov entry for Client Service entry failed!!!"," ",$PIECE(^VA(200,AMHPRV1,0),U)," ",AMHCDST
HANG 2
End DoDot:1
+38 SET AMHX=0
FOR
SET AMHX=$ORDER(AMHPROB(AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+39 SET X=$PIECE(AMHPROB(AMHX),U,5)
SET DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04///"_$PIECE(AMHPROB(AMHX),U,2)
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
+40 IF Y=-1
WRITE !!,"Creating POV entry failed!!!",$CHAR(7),$CHAR(7)
HANG 2
+41 DO ^XBFMK
End DoDot:1
+42 ;S AMHACTN=1
+43 ;D PCCLINK^AMHCDBL
+44 QUIT
PROBCONV ;
+1 SET X=0
FOR
SET X=$ORDER(AMHPROB(X))
IF X'=+X
QUIT
SET %=$$PCONV($PIECE(AMHPROB(X),U,3))
SET $PIECE(AMHPROB(X),U,4)=%
SET $PIECE(AMHPROB(X),U,5)=$ORDER(^AMHPROB("B",%,0))
+2 QUIT
GETVSITS ; EP - GET CDMIS VISITS FOR THIS CLIENT
+1 KILL ^TMP("AMHCONV",$JOB,"VISITS")
+2 SET AMHVCNT=0
SET Y=0
+3 FOR
SET Y=$ORDER(^ACDVIS("D",AMHPAT,Y))
IF 'Y
QUIT
SET X=^ACDVIS(Y,0)
IF $PIECE($GET(^("BWP")),U)=AMHLOC
Begin DoDot:1
+4 SET ^TMP("AMHCONV",$JOB,"VISITS",$PIECE(X,U),Y)=X
SET AMHVCNT=AMHVCNT+1
+5 QUIT
End DoDot:1
+6 QUIT
CHKFIN ; EP - CHECK FOR INITIAL CONTACT TYPE
+1 SET AMHX=""
SET (AMHY,Y)=0
+2 FOR
SET AMHX=$ORDER(^TMP("AMHCONV",$JOB,"VISITS",AMHX))
IF AMHX=""
QUIT
SET Y=0
FOR
SET Y=$ORDER(^TMP("AMHCONV",$JOB,"VISITS",AMHX,Y))
IF 'Y
QUIT
SET X=^(Y)
IF $PIECE(X,U,2)=AMHCOMPI
IF $PIECE(X,U,7)=AMHCOMTI
IF $PIECE(X,U,4)="IN"
SET AMHY=Y
QUIT
+3 QUIT
ACONV(P) ;
+1 IF P=7
QUIT 41
+2 IF P="ACU"
QUIT 23
+3 IF P=19
QUIT 23
+4 IF P=6
QUIT 23
+5 IF P=11
QUIT 23
+6 IF P=23
QUIT 23
+7 IF P="ACO"
QUIT 12
+8 IF P="DUI"
QUIT 12
+9 IF P="AOT"
QUIT 12
+10 IF P=14
QUIT 34
+11 IF P=16
QUIT 31
+12 IF P=15
QUIT 61
+13 IF P=13
QUIT 14
+14 IF P=3
QUIT 14
+15 IF P=4
QUIT 14
+16 IF P=2
QUIT 13
+17 IF P=1
QUIT 12
+18 IF P="MAS"
QUIT 23
+19 IF P=20
QUIT 23
+20 IF P="MMO"
QUIT 23
+21 IF P=10
QUIT 34
+22 IF P=12
QUIT 34
+23 IF P="PH"
QUIT 26
+24 IF P=10
QUIT 23
+25 IF P=22
QUIT 23
+26 IF P=17
QUIT 25
+27 IF P=21
QUIT 23
+28 IF P=9
QUIT 14
+29 IF P=8
QUIT 14
+30 IF P=5
QUIT 82
+31 IF P=18
QUIT 38
+32 IF P="URS"
QUIT 23
+33 IF P="CNOS1"
QUIT 12
+34 IF P="CNOS2"
QUIT 12
+35 IF P="CNOS3"
QUIT 12
+36 IF P="MIA"
QUIT 23
+37 IF P="OTH"
QUIT 23
+38 QUIT 23
PCONV(P) ;
+1 IF P=17
QUIT 89
+2 IF P=1
QUIT 29
+3 IF P=18
QUIT 94
+4 IF P=30
QUIT 43
+5 IF P=2
QUIT 30
+6 IF P=42
QUIT 23
+7 IF P=16
QUIT 3
+8 IF P=36
QUIT 42.2
+9 IF P=40
QUIT 44.2
+10 IF P=32
QUIT 43.2
+11 IF P=12
QUIT 59
+12 IF P=14
QUIT 79
+13 IF P=60
QUIT 312.31
+14 IF P=61
QUIT 26
+15 IF P=44
QUIT 302.6
+16 IF P=53
QUIT 80
+17 IF P=3
QUIT "305.90"
+18 IF P=13
QUIT 88
+19 IF P=11
QUIT 56
+20 IF P=15
QUIT 5
+21 IF P=55
QUIT 3
+22 IF P="MIA"
QUIT 8
+23 IF P=37
QUIT 47
+24 IF P=41
QUIT 48
+25 IF P=33
QUIT 49
+26 IF P=19
QUIT 82
+27 IF P=20
QUIT 26
+28 IF P=34
QUIT 42.1
+29 IF P=38
QUIT 44.1
+30 IF P=49
QUIT 66
+31 IF P=35
QUIT 42.3
+32 IF P=39
QUIT 44.3
+33 IF P=31
QUIT 43.3
+34 IF P=43
QUIT 302.9
+35 IF P=50
QUIT 62
+36 IF P=10
QUIT 304.83
+37 IF P=9
QUIT 62
+38 IF P=47
QUIT 40
+39 IF P=48
QUIT 41
+40 IF P=46
QUIT 41
+41 IF P=45
QUIT 39
+42 IF P=29
QUIT "305.10"
+43 QUIT 4
