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

AMHEYREX.m

Go to the documentation of this file. 
  1. AMHEYREX ; IHS/CMI/LAB - CMI ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1.  ;
  1.  ;
  1.  ;
  1. START ;Begin processing backload
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC(),80),!
  1.  S X="*****  BEHAVIORAL HEALTH RE-EXPORT IN A DATE RANGE  *****" W !,$$CTR(X,80),!
  1.  W !,"ATTENTION:  This option should ONLY be run if you have had",!,"a special request from IHS to re-send a large amount of previously",!,"exported data."
  1.  W !,"You should use the GEN and REDO options for all regularly scheduled exports.",!!
  1.  S T="INTRO" F J=1:1 S X=$T(@T+J),X=$P(X,";;",2) Q:X="END"  W !,X
  1.  K J,X,T
  1.  ;
  1. CHKSITE ; CHECK SITE FILE
  1.  I '$D(^AMHSITE(DUZ(2),0)) W !!,"*** Site file has not been setup! ***" S AMH("QFLG")=1 Q
  1.  I '$D(^AMHSITE(DUZ(2))) W !!,"*** RUN LOCATION not in SITE file!" S AMH("QFLG")=2 Q
  1.  I $D(^XTMP("AMHEXRL",$J)) W !!,"xtmp nodes around from previous run......" D XIT Q
  1.  W !,"A file will be created and will be placed in the public directory where",!,"all other exports are placed.  It will be called AMHX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_$$NLOG,!
  1.  I $D(^BHSXDATA) W !!,$C(7),$C(7),"BHSXDATA GLOBAL EXISTS FROM A PREVIOUS RUN - CANNOT CONTINUE" D XIT Q
  1. GETDATES ;
  1.  W !,"Please enter the date range for which the records should be generated.",!
  1. BD ;
  1.  S DIR(0)="D^::EP",DIR("A")="Enter Beginning Date",DIR("?")="Enter the beginning date." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  G:$D(DIRUT) XIT
  1.  S AMHBD=Y
  1. ED ;
  1.  S DIR(0)="DA^::EP",DIR("A")="Enter Ending Date:  " D ^DIR K DIR,DA S:$D(DUOUT) DIRUT=1
  1.  G:$D(DIRUT) XIT
  1.  I Y<AMHBD W !,"Ending date must be greater than or equal to beginning date!" G ED
  1.  S AMHED=Y
  1.  S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X
  1.  S AMHERR=0
  1.  W !!,"Log entry ",$$NLOG," will be created and records generated for visit",!,"date range ",$$FMTE^XLFDT(AMHBD)," to ",$$FMTE^XLFDT(AMHED),".",!
  1. CONT ;continue or not
  1.  S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) W !!,"Goodbye" D XIT Q
  1.  I 'Y W !!,"Goodbye" D XIT Q
  1.  S AMHRUN="NEW",AMHERR=0
  1.  D HOME^%ZIS S AMHBS=$S('$D(ZTQUEUED):IOBS,1:"")
  1.  D GENLOG ;generate new log entry
  1.  I $G(AMHERR) D XIT Q
  1.  D QUEUE
  1.  I $G(AMHERR) W !!,"Goodbye, no processing will occur.",! D XIT Q
  1.  I $D(AMHQUE) D XIT Q
  1.  ;
  1. PROCESS ;EP - process new run
  1.  S AMHCNT=$S('$D(ZTQUEUED):"X AMHCNT1  X AMHCNT2",1:"S AMHTOTV=AMHTOTV+1"),AMHCNT1="F AMHCNTL=1:1:$L(AMHTOTV)+1 W @AMHBS",AMHCNT2="S AMHTOTV=AMHTOTV+1 W AMHTOTV,"")"""
  1.  W:'$D(ZTQUEUED) !,"Generating transactions.  Counting visits.  (1)"
  1.  K ^BHSXDATA
  1.  S AMHSD=AMHSD_".9999"
  1.  ;set counters
  1.  S (AMHTOTV,AMHTERR,AMHTOTR,AMHUSED,AMH("ENC"),AMH("COUNT"),AMH("ERROR COUNT"))=0 K AMHERRT
  1. V ; Run by visit date
  1.  F  S AMHSD=$O(^AMHREC("B",AMHSD)) Q:AMHSD=""!((AMHSD\1)>AMHED)  D V1
  1. SF ;
  1.  W:'$D(ZTQUEUED) !,"Generating suicide forms..."
  1.  S AMHCNTR=0,AMH("CONTROL DATE")="",AMHSFC=0
  1.  S AMHSD=AMHSD_".9999"
  1.  F  S AMHSD=$O(^AMHPSUIC("AD",AMHSD)) Q:AMHSD=""!(AMHSD>AMHED)  D
  1.  .S AMHSFIEN=0 F  S AMHSFIEN=$O(^AMHPSUIC("AD",AMHSD,AMHSFIEN)) Q:AMHSFIEN'=+AMHSFIEN  D
  1.  ..I '$D(^AMHPSUIC(AMHSFIEN,0)) K ^AMHPSUIC("AD",AMHSD,AMHSFIEN) Q
  1.  ..S AMHSREC=^AMHPSUIC(AMHSFIEN,0)
  1.  ..S DFN=$P(AMHSREC,U,4)
  1.  ..S AMHRIEN=$O(^AMHRECD("B","BH2",0))
  1.  ..I 'AMHRIEN Q
  1.  ..S AMHY=0,AMHTX="" F  S AMHY=$O(^AMHRECD(AMHRIEN,11,"B",AMHY)) Q:AMHY'=+AMHY  D
  1.  ...S X=""
  1.  ...S AMHZ=$O(^AMHRECD(AMHRIEN,11,"B",AMHY,0))
  1.  ...Q:'$D(^AMHRECD(AMHRIEN,11,AMHZ,1))
  1.  ...X ^AMHRECD(AMHRIEN,11,AMHZ,1)
  1.  ...S $P(AMHTX,U,AMHY)=X
  1.  ..S AMH("COUNT")=AMH("COUNT")+1,AMHSFC=AMHSFC+1
  1.  ..S ^XTMP("AMHEXRL",$J,"SF",AMHSFIEN)=""
  1.  ..S ^BHSXDATA(AMH("COUNT"))=AMHTX
  1.  S DA=AMHLOG,DIE="^AMHEXRL(",DR=".05///"_AMHTOTR_";.06///"_AMH("ERROR COUNT")_";.07///"_AMH("COUNT")_";.08///P;.12////"_AMHSFC_";.13////"_AMH("ENC") D ^DIE K DIE,DA,DR ;no error check
  1.  S ^AMHEXRL(AMHLOG,11,0)="^9001005.41A^0^0"
  1.  S X="",C=0 F  S X=$O(AMHERRT(X)) Q:X=""  S C=C+1,^AMHEXRL(AMHLOG,11,C,0)=X_"^"_AMHERRT(X)
  1.  S DA=AMHLOG,DIK="^AMHEXRL(" D IX1^DIK K DA,DIK
  1.  D WRITEF
  1.  D RESET
  1.  D XIT
  1.  Q
  1. V1 ;go through each visit on this date
  1.  S AMHR="" F  S AMHR=$O(^AMHREC("B",AMHSD,AMHR)) Q:AMHR'=+AMHR  I $D(^AMHREC(AMHR,0)) S AMHVREC=^(0) D PROC
  1.  Q
  1. PROC ;
  1. GENREC ;generate record
  1.  K AMHT,AMHV,AMHE
  1.  D KILL^AUPNPAT
  1.  X AMHCNT
  1.  S AMHREC=^AMHREC(AMHR,0)
  1.  S AMHV("R DATE")=+AMHREC\1
  1.  S AMHTOTR=AMHTOTR+1
  1.  K AMHE,AMHTX D RECORD^AMHEYD2
  1.  D CNTBUILD
  1.  D ^XBFMK
  1.  Q
  1. CNTBUILD ;count and build tx
  1.  I AMHE]"" S AMH("ERROR COUNT")=AMH("ERROR COUNT")+1 D ERRLOG Q
  1.  S ^XTMP("AMHEXRL",$J,"VISITS",AMHR)=""
  1.  S AMH("COUNT")=AMH("COUNT")+1
  1.  S ^BHSXDATA(AMH("COUNT"))=AMHTX
  1.  Q
  1. QUEUE ;EP
  1.  K ZTSK
  1.  S DIR(0)="Y",DIR("A")="Do you want to QUEUE this to run at a later time",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y=1 D QUEUE1 Q
  1.  I AMHRUN="NEW",$D(DIRUT) S AMHERR=1 S DA=AMHLOG,DIK="^AMHEXRL(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA
  1.  I AMHRUN="REDO",$D(DIRUT) S AMHERR=1 Q
  1.  Q
  1. QUEUE1 ;
  1.  S ZTRTN="PROCESS^AMHEYREX"
  1.  S ZTIO="",ZTDTH="",ZTDESC="BH EXPORT DATE RANGE" S ZTSAVE("AMH*")=""
  1.  D ^%ZTLOAD
  1.  W !!,$S($D(ZTSK):"Request Queued!!",1:"Request cancelled")
  1.  I '$D(ZTSK),AMHRUN="NEW" S AMHERR=1 S DA=AMHLOG,DIK="^AMHEXRL(" W !,"Okay, you '^'ed out or timed out so I'm deleting the Log entry and quitting.",! D ^DIK K DIK,DA Q
  1.  S AMHQUE=""
  1.  S DIE="^AMHEXRL(",DA=AMHLOG,DR=".08///Q" D ^DIE K DIE,DA,DR
  1.  K ZTSK
  1.  Q
  1. WRITEF ;EP - write out flat file
  1.  I '$D(^BHSXDATA) W:'$D(ZTQUEUED) !!,"No transactions to send in that date range.",! Q
  1.  S XBGL="BHSXDATA"
  1.  S AMHTX="BH0"
  1.  S $P(AMHTX,U,2)=$P($G(^AUTTSITE(1,1)),U,3)
  1.  S $P(AMHTX,U,3)=$P($G(^AUTTLOC($P(^AUTTSITE(1,0),U),1)),U,3)
  1.  S $P(AMHTX,U,4)=$P(^DIC(4,$P(^AUTTSITE(1,0),U),0),U)
  1.  S $P(AMHTX,U,5)=$$DATE^AMHUTIL(DT)
  1.  S $P(AMHTX,U,6)=$$DATE^AMHUTIL($P(^AMHEXRL(AMHLOG,0),U,3))
  1.  S $P(AMHTX,U,7)=$$DATE^AMHUTIL($P(^AMHEXRL(AMHLOG,0),U,4))
  1.  S $P(AMHTX,U,8)="R"
  1.  S $P(AMHTX,U,9)=$P(^AMHEXRL(AMHLOG,0),U,7)
  1.  S $P(AMHTX,U,10)=$P(^AMHEXRL(AMHLOG,0),U,13)
  1.  S $P(AMHTX,U,11)=$P(^AMHEXRL(AMHLOG,0),U,12)
  1.  S ^BHSXDATA(0)=AMHTX
  1.  S XBMED="F",XBFN="BHSX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_AMHLOG,XBTLE="SAVE OF BH BACKLOAD RECORDS GENERATED BY -"_$P(^VA(200,DUZ,0),U)
  1.  S XBF="",XBQ="N"
  1.  D ^XBGSAVE
  1.  ;check for error
  1.  I XBFLG=-1 S AMHERR=1 W:'$D(ZTQUEUED) !,$C(7),$C(7),XBFLG(1) Q
  1.  K ^BHSXDATA
  1.  S DA=AMHLOG,DIE="^AMHEXRL(",DR=".08///S;.11////AMHX"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_AMHLOG D ^DIE K DA,DIE,DR
  1.  K XBGL,XBMED,XBTLE,XBFN,XBF,XBQ,XBFLT
  1.  Q
  1. GENLOG ;generate new log entry
  1.  W:'$D(ZTQUEUED) !,"Generating New Log entry.."
  1.  S Y=$$NLOG S X=""""_Y_"""",DIC="^AMHEXRL(",DIC(0)="L",DLAYGO=9002014.6,DIC("DR")=".02////"_DT_";.03////"_AMHBD_";.04////"_AMHED_";.09///`"_DUZ(2)
  1.  D ^DIC K DIC,DLAYGO,DR
  1.  I Y<0 W !!,$C(7),$C(7),"Error creating log entry." S AMHERR=1 Q
  1.  S AMHLOG=+Y
  1.  Q
  1. XIT ;exit, eoj cleanup
  1.  D EOP
  1.  D ^XBFMK
  1.  D EN^XBVK("AMH")
  1.  D KILL^AUPNPAT
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR("A")="End of Job.  Press Return.",DIR(0)="E" D ^DIR
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1. DATE(D) ;EP ;IHS/CMI/LAB - new date format - format date in YYYYMMDD format
  1.  I $G(D)="" Q ""
  1.  Q $E(D,1,3)+1700_$E(D,4,7)
  1.  ;
  1.  ;
  1. NLOG() ;get next log
  1.  NEW X,L S (X,L)=0 F  S X=$O(^AMHEXRL(X)) Q:X'=+X  S L=X
  1.  Q L+1
  1. INTRO ;introductory text
  1.  ;;This program will generate Behavioral Health export records for a visit
  1.  ;;date range that you enter.  Suicide forms entered in the date range
  1.  ;;will also be exported.  A log entry will be created which will log
  1.  ;;the number of visits processed and the number of records
  1.  ;;generated.  
  1.  ;;
  1.  ;;END
  1. RESET ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE
  1.  W:'$D(ZTQUEUED) !,"RE-setting export date. (1)"
  1.  S AMHCNTR=0,AMHR=""
  1.  F  S AMHR=$O(^XTMP("AMHEXRL",$J,"VISITS",AMHR)) Q:AMHR'=+AMHR  D RESET1
  1.  D PURGESF
  1.  K ^XTMP("AMHEXRL",$J)
  1.  Q
  1.  ;
  1. RESET1 ; kill MHSS xref and set flag if tx 23 or 24 generated
  1.  S DIE="^AMHREC(",DA=AMHR,DR=".24///"_DT D CALLDIE^AMHLEIN
  1.  X AMHCNT
  1.  Q
  1.  ;
  1. PURGESF ; PURGE 'AEX' XREF FOR MHSS RECORDS JUST DONE
  1.  S AMHCNTR=0,AMHR=0
  1.  F  S AMHR=$O(^XTMP("AMHEXRL",$J,"SF",AMHR)) Q:AMHR'=+AMHR  D RESETSF
  1.  Q
  1. RESETSF ; kill MHSS xref and set flag if tx 23 or 24 generated
  1.  S DA=AMHR,DIE="^AMHPSUIC(",DR=".23////"_DT D CALLDIE^AMHLEIN
  1.  X AMHCNT
  1.  Q
  1. ERRLOG ;
  1.  S AMHERRTX=$O(^AMHERR("B",AMHE,0)) I AMHERRTX="" S AMHERRT("UNKNOWN ERROR")=$G(AMHERRT("UNKNOWN ERROR"))+1
  1.  S AMHERRTX=$P(^AMHERR(AMHERRTX,0),U,2) I AMHERRTX="" S AMHERRT("UNKNOWN ERROR")=$G(AMHERRT("UNKNOWN ERROR"))+1
  1.  S AMHERRT(AMHERRTX)=$G(AMHERRT(AMHERRTX))+1
  1.  Q