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

AMHCDBL.m

Go to the documentation of this file. 
  1. AMHCDBL ; IHS/CMI/LAB - backload pcc visits ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1.  ;
  1.  ;backfill BH with CDMIS Data
  1.  ;
  1. EP ;
  1.  I '$D(^AMHTCOMP("B","PREVENTION")) D
  1.  .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
  1.  .K DIADD,DLAYGO
  1.  .D ^XBFMK
  1.  .Q
  1. START ;
  1.  I $$VERSION^XPDUTL("ACD")<4.1 W !!,"CDMIS IS NOT UP TO VERSION 4.1, CANNOT CONTINUE" D XIT Q
  1.  K ^TMP($J)
  1.  S DIFGLINE=1
  1.  W !!,"This routine is used to backload CDMIS data into the BH package."
  1.  W !!,"This option should be only by those sites that have discontinued"
  1.  W !,"the use of the CDMIS module.",!
  1.  W !,"Only visits in a date range you specify will be transferred."
  1.  W !,"You should decide ahead of time how far back you want to go"
  1.  W !,"in backloading data.  It might be wise to just backload the past"
  1.  W !,"1 or 2 years worth of data first and then decide if older data"
  1.  W !,"should be moved.",!!
  1. CONT ;
  1.  S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  G:$D(DIRUT) XIT
  1.  I 'Y G XIT
  1. D ;date range
  1.  K AMHED,AMHBD
  1.  K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date of CDMIS Visits to backload"
  1.  D ^DIR S:Y<1 AMHQUIT=1 G:Y<1 START  S AMHBD=Y
  1.  K DIR S DIR(0)="DO^::EXP",DIR("A")="Enter Ending Date of CDMIS Visits to backload"
  1.  D ^DIR S:Y<1 AMHQUIT=1 G:Y<1 D  S AMHED=Y
  1.  ;
  1.  I AMHED<AMHBD D  G D
  1.  . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1.  W !,"Please enter the location to be used as a default for Prevention Activities."
  1.  S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("B")=$$VAL^XBDIQ1(9002013,DUZ(2),.28) D ^DIC
  1.  K DIC,DA
  1.  I Y=-1 D XIT Q
  1.  S AMHDLOC=+Y
  1.  W !,"Please enter the community to be used as a default for all records created."
  1.  S DIC="^AUTTCOM(",DIC(0)="AEMQ",DIC("B")=$$VAL^XBDIQ1(9002013,DUZ(2),.29) D ^DIC
  1.  K DIC,DA
  1.  I Y=-1 D XIT Q
  1.  S AMHDCOM=+Y
  1. PCC ;
  1.  W !!,"These CDMIS visits do not need to pass to PCC because they are old visits."
  1.  S AMHPCCL=0,AMHLPCC=0
  1.  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
  1.  G:$D(DIRUT) XIT
  1.  I Y S AMHPCCL=1,AMHLPCC=1
  1. PROC ;
  1.  W !!,"Please be patient while the conversion process takes place..."
  1.  W !,"Moving CDMIS Prevention Activities"
  1.  D CDPREV
  1.  W !,"Moving CDMIS visits"
  1.  D CDVISIT
  1.  W !!,"all done"
  1.  ;S DA=DUZ(2),DR="1501///1",DIE="^AMHSITE(" D ^DIE
  1.  K ^TMP($J)
  1.  D EN^XBVK("AMH")
  1.  D ^XBFMK
  1.  K DIFGLINE
  1.  Q
  1. CDVISIT ;
  1.  D ^AMHLEIN
  1.  S AMHBL=1,AMHCIN=0,AMHCRE=0,AMHCFU=0,AMHCIR=0,AMHCOT=0,AMHCTD=0
  1.  S APCDOVRR=1,AMHCDVS=0
  1.  S AMHIEN=0 F  S AMHIEN=$O(^ACDVIS(AMHIEN)) Q:AMHIEN'=+AMHIEN  D
  1.  .S AMHR0=$G(^ACDVIS(AMHIEN,0))
  1.  .Q:$D(^ACDVIS(AMHIEN,"BHCONV"))
  1.  .S ^ACDVIS(AMHIEN,"BHCONV")=""
  1.  .W "."
  1.  .Q:AMHR0=""
  1.  .S AMHDATE=$P(AMHR0,U,1)
  1.  .Q:AMHDATE<AMHBD
  1.  .Q:AMHDATE>AMHED
  1. DE .;
  1.  .S AMHCOMP=$$VAL^XBDIQ1(9002172.1,AMHIEN,1),AMHCOMPI=$P(AMHR0,U,2)
  1.  .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))
  1.  .S AMHCOMT=$$VAL^XBDIQ1(9002172.1,AMHIEN,5),AMHCOMTI=$P(AMHR0,U,7)
  1.  .S AMHPROV=$P(AMHR0,U,3)
  1.  .S AMHTC=$P(AMHR0,U,4)
  1.  .S AMHPAT=$P(AMHR0,U,5)
  1.  .;Q:AMHPAT=""
  1.  .S AMHLOC=$G(^ACDVIS(AMHIEN,"BWP")) I AMHLOC="" S AMHLOC=DUZ(2)
  1.  .I AMHTC="IN" S AMHACT=12 D IN S AMHCIN=AMHCIN+1 Q
  1.  .I AMHTC="RE" S AMHACT=12 D IN S AMHCRE=AMHCRE+1 Q
  1.  .I AMHTC="FU" S AMHACT=21 D IN S AMHCFU=AMHCFU+1 Q
  1.  .I AMHTC="IR" S AMHACT=25 D IN S AMHCIR=AMHCIR+1
  1.  .I AMHTC="OT" S AMHACT=48 D IN S AMHCOT=AMHCOT+1 Q
  1.  .I AMHTC="TD" S AMHACT=19 D TD^AMHCDBL1 S AMHCTD=AMHCTD+1 Q
  1.  .;I AMHTC="CS" S AMHACT="" D CS^AMHCDBL2
  1.  W !,"moved ",AMHCDVS," cdmis visits"
  1.  W !,AMHCIN," initial"
  1.  W !,AMHCRE," reopen"
  1.  W !,AMHCFU," follow up"
  1.  W !,AMHCIR," info/referral"
  1.  W !,AMHCOT," other"
  1.  W !,AMHCTD," trans/disc"
  1.  Q
  1. IN ;
  1.  D IN^AMHCDBL1
  1.  Q
  1. CDPREV ;
  1.  ;move all entries from ACDPD using month/yr from .01 field and then date from .01 of multiple
  1.  ;
  1.  S AMHCDPRC=0
  1.  S AMHIEN=0 F  S AMHIEN=$O(^ACDPD(AMHIEN)) Q:AMHIEN'=+AMHIEN  D
  1.  .W "."
  1.  .S AMHR0=$G(^ACDPD(AMHIEN,0))
  1.  .Q:AMHR0=""
  1.  .S AMHMY=$E($P(AMHR0,U),1,5)
  1.  .S AMHCOMP=$$VAL^XBDIQ1(9002170.7,AMHIEN,1)
  1.  .I AMHCOMP="" S AMHCOMP="OTHER",AMHCOMPB=$O(^AMHTCOMP("B","OTHER",0)) G C1
  1.  .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))
  1. C1 .S AMHCOMT=$$VAL^XBDIQ1(9002170.7,AMHIEN,2)
  1.  .S AMHLOC=$P(AMHR0,U,4)
  1.  .S AMHMIEN=0 F  S AMHMIEN=$O(^ACDPD(AMHIEN,1,AMHMIEN)) Q:AMHMIEN'=+AMHMIEN  D
  1.  ..I $D(^ACDPD(AMHIEN,1,AMHMIEN,"BHCONV")) Q  ;already moved
  1.  ..S AMHMR0=^ACDPD(AMHIEN,1,AMHMIEN,0)
  1.  ..S AMHDAY=$P(AMHMR0,U) I $L(AMHDAY)=1 S AMHDAY="0"_AMHDAY
  1.  ..S AMHDATE=AMHMY_AMHDAY S X=AMHDATE,%DT="" D ^%DT I Y=-1 Q  ;W !,"invalid date: ",AMHDATE," ien: ",AMHIEN," ",AMHMIEN Q
  1.  ..I AMHDATE<AMHBD!(AMHDATE>AMHED) Q
  1.  ..S AMHPRA=$P(AMHMR0,U,2) I AMHPRA="" W !,"NO prevention activity, skipping" Q
  1.  ..S AMHPRA=$P(^ACDPREV(9002170.9,AMHPRA,0),U)
  1.  .. S X=AMHPRA,DIC(0)="M",DIC="^AMHTPA(" D ^DIC S AMHPRAB=+Y I AMHPRAB="" W !,"Could not map prevention activity: ",AMHPRA Q
  1.  .. K DIC D ^XBFMK
  1.  ..S AMHTAR=$P(AMHMR0,U,4)
  1.  ..S AMHNS=$P(AMHMR0,U,5)
  1.  ..S AMHCAT=$P(AMHMR0,U,7) I AMHCAT S AMHCAT=$O(^ACDLOT(AMHCAT,0),U)
  1.  ..S AMHCAT=$$TOC(AMHCAT)
  1.  ..S AMHTIME=$P(AMHMR0,U,8) I AMHTIME="" W !,"no time on prevention.. skipping ",AMHIEN," ",AMHMIEN Q
  1.  ..S AMHTIME=AMHTIME*60
  1.  ..;create MHSS record
  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 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
  1.  ..I $D(Y) W !!,"error editing MHSS Record entry ",AMHIEN," ",AMHMIEN
  1.  ..;now create provider
  1.  ..S AMHIENP=0,AMHC=0 F  S AMHIENP=$O(^ACDPD(AMHIEN,1,AMHMIEN,"PRV",AMHIENP)) Q:AMHIENP'=+AMHIENP  D
  1.  ...S Y=$P(^ACDPD(AMHIEN,1,AMHMIEN,"PRV",AMHIENP,0),U)
  1.  ...S AMHC=AMHC+1
  1.  ...S AMHPS=$S(AMHC=1:"P",1:"S")
  1.  ...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
  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 Y=$O(^AMHPROB("B",99,0))
  1.  ..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
  1.  ..I Y=-1 W !!,"Creating POV entry failed!!!",$C(7),$C(7) H 2
  1.  ..D ^XBFMK
  1.  ..;now create prevention activity
  1.  ..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
  1.  ..I Y=-1 W !!,"Creating PREVENTION ACTIVITY entry failed!!!",$C(7),$C(7) H 2
  1.  ..D ^XBFMK
  1.  ..S ^ACDPD(AMHIEN,1,AMHMIEN,"BHCONV")=""
  1.  ..S AMHCDPRC=AMHCDPRC+1
  1.  W !!,"A total of ",AMHCDPRC," CDMIS prevention activities moved to BH."
  1.  Q
  1. XIT ;
  1.  W !!,"ALL DONE",!
  1.  D EN^XBVK("AMH")
  1.  D ^XBFMK
  1.  Q
  1. TOC(X) ;
  1.  I X="" Q 4
  1.  I X="SCHOOL" Q 6
  1.  I X="COMMUNITY FACILITY" Q 4
  1.  I X="CONTRACT PROGRAM" Q 4
  1.  I X="HOME" Q 5
  1.  I X="JAIL/COURTS" Q 14
  1.  I X="MEDICAL FACILITY" Q 3
  1.  I X="OTHER" Q 4
  1.  I X="OUTDOORS" Q 4
  1.  I X="PROGRAM FACILITY" Q 2
  1.  I X="REGIONAL TRTMNT CTR" Q 11
  1.  Q 4
  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.  Q:AMHPAT=""
  1.  S AMHPTYPE="C"
  1.  Q:'$P(^AMHTACT($P(^AMHREC(AMHR,0),U,6),0),U,4)
  1.  S DFN=AMHPAT
  1.  S AMHACTN=1
  1.  ;check for pcc visit on this date
  1.  Q:$$VIS(AMHPAT,AMHDATE)  ;quit if already an alcohol clinic visit on this date
  1.  D PCCLINK^AMHLE2
  1.  S V=$P(^AMHREC(AMHR,0),U,16)
  1.  I V K ^AUPNVSIT("ABILL",DT,V),^AUPNVSIT("ADWO",DT,V)
  1.  Q
  1. VIS(P,D) ;
  1.  NEW X,Y,G
  1.  S G=0
  1.  S X=9999999-AMHDATE,Y=0 F  S X=$O(^AUPNVSIT("AA",P,X)) Q:$P(X,".")>AMHDATE!(X="")  D
  1.  .S Y=0 F  S Y=$O(^AUPNVSIT("AA",P,X,Y)) Q:Y'=+Y  I $$CLINIC^APCLV(Y,"C")=43 S G=1
  1.  .Q
  1.  Q G