AMHCDBL2.m

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