Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMHCDBL1

AMHCDBL1.m

Go to the documentation of this file. 
  1. AMHCDBL1 ; IHS/CMI/LAB - backload pcc visits ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1.  ;
  1.  ;backfill BH with CDMIS Data
  1. IN ;EP
  1.  ;create MHSS record first
  1.  S AMHCDST=$O(^ACDIIF("C",AMHIEN,0))
  1.  I 'AMHCDST W !!,"INITIAL entry not complete, skipping ",AMHIEN Q
  1.  I $E(AMHDATE,6,7)="00" S AMHDATE=$E(AMHDATE,1,5)_"01"
  1.  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"
  1.  K DD,DO,D0 D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
  1.  I Y=-1 W !!,$C(7),$C(7),"Error creating Behavioral Health Record!!  Deleting Record.",! Q
  1.  S AMHR=+Y,DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR
  1.  S AMHTIME=$P($G(^ACDIIF(AMHCDST,0)),U,6) S AMHTIME=AMHTIME*60 I 'AMHTIME S AMHTIME=1
  1.  S DIE="^AMHREC(",DA=AMHR
  1.  S DR=".04////"_AMHLOC_";.05////"_AMHDCOM_";.06///"_AMHACT_";.07///"_$S(AMHCOMP="PRIMARY RESID":11,1:2)_";.08////"_AMHPAT_";.09///1;1101///"_AMHCOMP_";.12///"_AMHTIME_";.25///43;.32///"_AMHTC_";1105///"_AMHCOMT,DIE="^AMHREC(" D ^DIE
  1.  I $D(Y) W !!,"error editing MHSS Record entry ",AMHIEN," ",AMHMIEN
  1.  ;get initial entry and file activity time and mhss staging tool entry, get problem for later use
  1.  S AMHSTR0=^ACDIIF(AMHCDST,0)
  1.  K AMHPROB
  1.  S AMHPROB(1)=$P(AMHSTR0,U)_U_$P(^ACDPROB($P(AMHSTR0,U),0),U)_U_$P(^ACDPROB($P(AMHSTR0,U),0),U,2)
  1.  ;S ^TMP($J,"ACDCONV",AMHPAT,9999999-AMHDATE)=AMHPROB(1)
  1.  S AMHC=1
  1.  S X=0 F  S X=$O(^ACDIIF(AMHCDST,3,X)) Q:X'=+X  D
  1.  .S AMHC=AMHC+1
  1.  .S P=$P(^ACDIIF(AMHCDST,3,X,0),U)
  1.  .S N="" I $P(^ACDIIF(AMHCDST,3,X,0),U,2)]"" S N=$P(^ACDIIF(AMHCDST,3,X,0),U,2)]""
  1.  .I N="" S N=$P(^ACDPROB(P,0),U)
  1.  .S AMHPROB(AMHC)=P_U_N_U_$P(^ACDPROB(P,0),U,2)
  1.  .Q
  1.  D PROBCONV
  1.  D ^XBFMK
  1.  I AMHTC="IR"!(AMHTC="OT") G PROVPOV
  1.  S X=AMHR,DIC("DR")=".02////"_AMHPAT_";.03////"_$P(AMHPROB(1),U,5)_";.04////"_DT_";.05////"_DUZ_";.19///"_AMHTC,DIC="^AMHRCDST(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.06
  1.  K DD,DO D FILE^DICN K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
  1.  I Y=-1 W !!,"Creating STAGING TOOL entry failed!!!",$C(7),$C(7) H 2
  1.  S AMHSTIEN=+Y
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,6)=$P(AMHSTR0,U,4)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,7)=$P(AMHSTR0,U,5)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,8)=$P(AMHSTR0,U,7)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,9)=$P(AMHSTR0,U,8)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,12)=$P(AMHSTR0,U,10)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,13)=$P(AMHSTR0,U,11)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,14)=$P(AMHSTR0,U,12)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,15)=$P(AMHSTR0,U,13)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,16)=$P(AMHSTR0,U,14)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,17)=$P(AMHSTR0,U,15)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,18)=$P(AMHSTR0,U,22)
  1.  S (AMHRCOMP,AMHACOMP,AMHDIFF)=""
  1.  S X=$$VAL^XBDIQ1(9002170,AMHCDST,15)
  1.  I X]"" S AMHRCOMP=$O(^AMHTCOMP("B",X,0))
  1.  S X=$$VAL^XBDIQ1(9002170,AMHCDST,17)
  1.  I X]"" S AMHACOMP=$O(^AMHTCOMP("B",X,0))
  1.  S X=$$VAL^XBDIQ1(9002170,AMHCDST,19)
  1.  I X]"" S AMHDIFF=$O(^AMHTCDDR("B",X,0))
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,21)=AMHRCOMP
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,22)=AMHACOMP
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,23)=AMHDIFF
  1.  S DA=AMHSTIEN,DIK="^AMHRCDST(" D IX1^DIK K DA,DIK
  1.  D ^XBFMK
  1. PROVPOV ;now create pov/provider
  1.  S X=AMHPROV,DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04///P",DIC="^AMHRPROV(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.02
  1.  K DD,DO D FILE^DICN K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
  1.  I Y=-1 W !!,"Creating Primary Provider entry failed!!!",$C(7),$C(7) H 2
  1.  D ^XBFMK
  1.  ;now create POV
  1.  S AMHX=0 F  S AMHX=$O(AMHPROB(AMHX)) Q:AMHX'=+AMHX  D
  1.  .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
  1.  .I Y=-1 W !!,"Creating POV entry failed!!!",$C(7),$C(7) H 2
  1.  .D ^XBFMK
  1.  D PCCLINK^AMHCDBL
  1.  S AMHCDVS=AMHCDVS+1
  1.  Q
  1. TD ;EP
  1.  ;create MHSS record first
  1.  S AMHCDST=$O(^ACDTDC("C",AMHIEN,0))
  1.  I 'AMHCDST W !!,"TDC entry not complete, skipping ",AMHIEN Q
  1.  I $E(AMHDATE,6,7)="00" S AMHDATE=$E(AMHDATE,1,5)_"01"
  1.  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"
  1.  K DD,DO,D0 D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
  1.  I Y=-1 W !!,$C(7),$C(7),"Error creating Behavioral Health Record!!  Deleting Record.",! Q
  1.  S AMHR=+Y,DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR
  1.  S AMHTIME=$P($G(^ACDTDC(AMHCDST,0)),U,29) S AMHTIME=AMHTIME*60 I 'AMHTIME S AMHTIME=1
  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
  1.  I $D(Y) W !!,"error editing MHSS Record entry ",AMHIEN," ",AMHMIEN
  1.  ;get initial entry and file activity time and mhss staging tool entry, get problem for later use
  1.  S AMHSTR0=^ACDTDC(AMHCDST,0)
  1.  K AMHPROB
  1.  I '$P(AMHSTR0,U,27) W !,"no primary problem on discharge ",AMHIEN,"  ",AMHCDST S AMHC=0 G N
  1.  S AMHPROB(1)=$P(AMHSTR0,U,27)_U_$P(^ACDPROB($P(AMHSTR0,U,27),0),U)_U_$P(^ACDPROB($P(AMHSTR0,U,27),0),U,2)
  1.   S AMHC=1
  1. N ;
  1.  S X=0 F  S X=$O(^ACDTDC(AMHCDST,3,X)) Q:X'=+X  D
  1.  .S AMHC=AMHC+1
  1.  .S P=$P(^ACDTDC(AMHCDST,3,X,0),U)
  1.  .S N="" I $P(^ACDTDC(AMHCDST,3,X,0),U,2)]"" S N=$P(^ACDTDC(AMHCDST,3,X,0),U,2)]""
  1.  .I N="" S N=$P(^ACDPROB(P,0),U)
  1.  .S AMHPROB(AMHC)=P_U_N_U_$P(^ACDPROB(P,0),U,2)
  1.  .Q
  1.  D PROBCONV
  1.  D ^XBFMK
  1.  S X=AMHR,DIC("DR")=".02////"_AMHPAT_";.03////"_$P($G(AMHPROB(1)),U,5)_";.04////"_DT_";.05////"_DUZ_";.19///"_AMHTC,DIC="^AMHRCDST(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.06
  1.  K DD,DO D FILE^DICN K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
  1.  I Y=-1 W !!,"Creating STAGING TOOL entry failed!!!",$C(7),$C(7) H 2
  1.  S AMHSTIEN=+Y
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,6)=$P(AMHSTR0,U,4)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,7)=$P(AMHSTR0,U,5)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,8)=$P(AMHSTR0,U,7)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,9)=$P(AMHSTR0,U,8)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,12)=$P(AMHSTR0,U,10)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,13)=$P(AMHSTR0,U,11)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,14)=$P(AMHSTR0,U,12)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,15)=$P(AMHSTR0,U,13)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,16)=$P(AMHSTR0,U,14)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,17)=$P(AMHSTR0,U,15)
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,18)=$P(AMHSTR0,U,22)
  1.  S (AMHRCOMP,AMHACOMP,AMHDIFF)=""
  1.  S X=$$VAL^XBDIQ1(9002171,AMHCDST,15)
  1.  I X]"" S AMHRCOMP=$O(^AMHTCOMP("B",X,0))
  1.  S X=$$VAL^XBDIQ1(9002171,AMHCDST,17)
  1.  I X]"" S AMHACOMP=$O(^AMHTCOMP("B",X,0))
  1.  S X=$$VAL^XBDIQ1(9002171,AMHCDST,19)
  1.  I X]"" S AMHDIFF=$O(^AMHTCDDR("B",X,0))
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,21)=AMHRCOMP
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,22)=AMHACOMP
  1.  S $P(^AMHRCDST(AMHSTIEN,0),U,23)=AMHDIFF
  1.  S DA=AMHSTIEN,DIK="^AMHRCDST(" D IX1^DIK K DA,DIK
  1.  D ^XBFMK
  1.  ;now create pov/provider
  1.  S X=AMHPROV,DIC("DR")=".02////"_AMHPAT_";.03////"_AMHR_";.04///P",DIC="^AMHRPROV(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.02
  1.  K DD,DO D FILE^DICN K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
  1.  I Y=-1 W !!,"Creating Primary Provider entry failed!!!",$C(7),$C(7) H 2
  1.  D ^XBFMK
  1.  ;now create POV
  1.  Q:'$D(AMHPROB)
  1.  S AMHX=0 F  S AMHX=$O(AMHPROB(AMHX)) Q:AMHX'=+AMHX  D
  1.  .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
  1.  .I Y=-1 W !!,"Creating POV entry failed!!!",$C(7),$C(7) H 2
  1.  .D ^XBFMK
  1.  D PCCLINK^AMHCDBL S AMHCDVS=AMHCDVS+1
  1.  Q
  1. 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))
  1.  Q
  1. PCONV(P) ;
  1.  I P=17 Q 89
  1.  I P=1 Q 29
  1.  I P=18 Q 94
  1.  I P=30 Q 43
  1.  I P=2 Q 30
  1.  I P=42 Q 23
  1.  I P=16 Q 3
  1.  I P=36 Q 42.2
  1.  I P=40 Q 44.2
  1.  I P=32 Q 43.2
  1.  I P=12 Q 59
  1.  I P=14 Q 79
  1.  I P=60 Q 312.31
  1.  I P=61 Q 26
  1.  I P=44 Q 302.6
  1.  I P=53 Q 80
  1.  I P=3 Q "305.90"
  1.  I P=13 Q 88
  1.  I P=11 Q 56
  1.  I P=15 Q 5
  1.  I P=55 Q 3
  1.  I P="MIA" Q 8
  1.  I P=37 Q 47
  1.  I P=41 Q 48
  1.  I P=33 Q 49
  1.  I P=19 Q 82
  1.  I P=20 Q 26
  1.  I P=34 Q 42.1
  1.  I P=38 Q 44.1
  1.  I P=49 Q 66
  1.  I P=35 Q 42.3
  1.  I P=39 Q 44.3
  1.  I P=31 Q 43.3
  1.  I P=43 Q 302.9
  1.  I P=50 Q 62
  1.  I P=10 Q 304.83
  1.  I P=9 Q 62
  1.  I P=47 Q "40"
  1.  I P=48 Q 41
  1.  I P=46 Q 41
  1.  I P=45 Q 39
  1.  I P=29 Q "305.10"
  1.  Q ""