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

ACHSTX11.m

Go to the documentation of this file. 
  1. ACHSTX11 ; IHS/ITSC/PMF - EXPORT DATA.  Extract  
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1.  ;we get here if we are going to do an export.  REexporting
  1.  ;goes through another program.
  1.  ;
  1.  ;
  1.  ;I've looked at this process a whole lot, and this is the easiest
  1.  ;way of doing things that I can find.  What's going to happen is
  1.  ;that we will examine each transaction that has occurred from the
  1.  ;start date to the end date.  We will decide if this transaction
  1.  ;of this document will generate any records for export.
  1.  ;
  1.  ;If it does, we create them right away.  This is easy to do at this
  1.  ;point because we have already pulled most of the info about this
  1.  ;document from the detabase already.  What it means, though, is that
  1.  ;the calls will get pretty deep.  Remember that when reading the 
  1.  ;program for the first time and don't let it get you lost.
  1.  ;
  1.  ;When the records get created, they get put into different globals.
  1.  ;When allll of the records are created, we then take them out of
  1.  ;those globals and put them into ^ACHSDATA (the type 2 records are
  1.  ;already in that global.)  This is done so that the final result
  1.  ;will be a list of all of the type 2s then all of the type 3s, then
  1.  ;all of the type 4s, etc.
  1.  ;
  1.  ;
  1.  ;Deciding which records get created is complicated.  We have made it
  1.  ;as simple as possible, but it is still complicated.  None of the
  1.  ;records get generated due to exactly the same set of circumstances.
  1.  ;Instead, the circumstances overlap in some places and not in others.
  1.  ;When the code comes to that part of it, this is explained further.
  1.  ;
  1.  ;These programs are written more for clarity than for expediancy.  It
  1.  ;would be easy to make some some changes and save a few milliseconds,
  1.  ;but you would then not want to read the program.
  1.  ;
  1.  ;init some stuff.  If it fails, quit
  1.  D INIT I STOP Q
  1.  ;
  1.  ;remove two lines for testing !!!!!
  1.  ;D EXPRT
  1.  ;I STOP Q
  1.  ;
  1.  ;
  1.  ;W @IOF,!,ACHS("*"),!?30,"EXPORT CHS DATA",!,ACHS("*"),!
  1.  ;
  1.  ;record the start and end dates FDT is first date, LDT is last date 
  1.  ;S ACHSFDT=ACHSBDT,ACHSLDAT=ACHSEDT
  1.  ;
  1.  ;for test!!!!!
  1.  S ACHSBDT=ACHSSBD,ACHSEDT=ACHSSED
  1.  ;
  1.  ;for each day from start to end date, look for...
  1.  F  S ACHSBDT=$O(^ACHSF(DUZ(2),"TB",ACHSBDT)) Q:ACHSBDT=""!(ACHSBDT>ACHSEDT)  D EXTRCT
  1.  ;
  1.  K DOLH,PMFCOUNT
  1.  Q
  1.  ;
  1. EXTRCT ;
  1.  ;if this is the first day, set record count to 0
  1.  S:ACHSRCT=0 ACHSFDT=ACHSBDT
  1.  ;
  1.  ;for each transaction type except ZAs and IPs, do...
  1.  S ACHSTY="" F  S ACHSTY=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTY)) Q:ACHSTY=""  I ACHSTY'="ZA",(ACHSTY'="IP") D EXTR2
  1.  Q
  1.  ;
  1. EXTR2 ;
  1.  ;for each document of this type on this day...
  1.  S ACHSDIEN=0 F  S ACHSDIEN=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTY,ACHSDIEN)) Q:ACHSDIEN=""  D EXTR3
  1.  Q
  1. EXTR3 ;
  1.  ;go fetch the data on this document.  if it's not okay, stop
  1.  D ^ACHSDOCR I 'OK Q
  1.  D ^ACHSVNDR I 'OK Q
  1.  ;
  1.  ;if this is a blanket order, stop
  1.  I BLNKT=2 D KLL^ACHSDOCR,KLL^ACHSVNDR Q
  1.  ;
  1.  ;now that we have document data build some other pieces
  1.  S ACHSCTY=ACHSTY
  1.  S ACHSDOCN="0"_$P(ACHSDOCR,U,14)_ACHSFC_$E($P(ACHSDOCR,U)+100000,2,6)
  1.  ;
  1.  ;for each transaction within this trans type on the
  1.  ;    document for today...
  1.  S TNUM=0 F  S TNUM=$O(^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTY,ACHSDIEN,TNUM)) Q:TNUM=""  D EXTR4
  1.  D KLL^ACHSDOCR,KLL^ACHSVNDR
  1.  Q
  1.  ;
  1. EXTR4 ;EP from ACHSTX2R
  1.  ;
  1.  ;fo continuity with other programs, use DA for that last subscript
  1.  S DA=TNUM
  1.  ;
  1.  ;for test
  1.  ;W !,ACHSBDT,?15,ACHSTY,?30,ACHSDIEN,?45,TNUM R YAYA
  1.  ;
  1.  I $P($H,",",2)-TIME>3 W " ." S TIME=$P($H,",",2)
  1.  ;
  1.  ;make sure that the transaction that "TB" is pointing to actually
  1.  ;exists
  1.  I 'ACHSREEX,'$D(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",DA,0)) K ^ACHSF(DUZ(2),"TB",ACHSBDT,ACHSTY,ACHSDIEN,DA) Q
  1.  ;
  1.  S ACHSTRAN=^ACHSF(DUZ(2),"D",ACHSDIEN,"T",DA,0)
  1.  ;
  1.  ;get the initial payment amount and format it
  1.  S ACHSIPA=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",DA,0),U,4)
  1.  S ACHSIPA=$P(ACHSIPA,".",1)_$E($P(ACHSIPA,".",2)_"00",1,2),ACHSIPA=$E(ACHSIPA+1000000000000,2,13)
  1.  ;
  1.  ;if the type is Cancel, don't use it.  use the trans type instead
  1.  I ACHSCTY="C" S ACHSCTY=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,"T",DA,0),U,5)
  1.  ;
  1.  ;now decide if this document will generate some records.
  1.  ;each record type gets created or not based on several
  1.  ;parameters.  Not all of the records use all of the
  1.  ;parameters, though.  So there is OVERLAP in the way
  1.  ;records qualify, but it's a complicated pattern of
  1.  ;overlap.  You will see it the the next programs called.
  1.  ;
  1.  ;
  1.  ;When we are done here, the transactions that got made will be
  1.  ;in various different globals.
  1.  ;Also, there will be an entry in ^ACHSXPRT that looks like this:
  1.  ;
  1.  ;^ACHSXPRT(ACHSDIEN,DA)=r2^r3^r4^r5^r6^r7
  1.  ;
  1.  ;where ACHSDIEN is the internal sequence number of the document
  1.  ;      DA is the transaction subscript
  1.  ;      rx is the action taken on the document for trans type x
  1.  ;      for example, if r4 = "", we did not creat a type 4 trans
  1.  ;                               and we don't know why.
  1.  ;                               SHOULD NOT OCCUR.
  1.  ;                   if r5 = 0, that means a type 5 trans was created
  1.  ;                              a 0 ALWAYS means trans created.
  1.  ;                   if r3 = 17, then the trans was not created
  1.  ;                               for reason #17
  1.  ;
  1.  ;for test
  1.  S SDA=DA
  1.  ;
  1.  ;
  1.  ;AFTER the export file is created, BUT NOT BEFORE, we take the info
  1.  ;in ^ACHSXPRT and record it in ^ACHSTXST for permanent storage.
  1.  ;
  1.  ;each of the routines we call expect ACHSDOCR and the standard
  1.  ;document variables, which are returned unchanged, and the
  1.  ;routines will return RET with their outcome
  1.  S LIST="" F NUM=2:1:7 S ROUT="^ACHSTX"_NUM_NUM,RET="" D @ROUT S $P(LIST,U,NUM)=+RET
  1.  ;
  1.  ;SDA for test
  1.  S ^ACHSXPRT(DOLRH,ACHSDIEN,SDA)=LIST K SDA
  1.  ;
  1.  Q
  1.  ;
  1. EXPRT ;
  1.  ;set up for exporting, as opposed to REexporting
  1.  ;
  1.  ;beginning date starts as the end date of the last export
  1.  S P=$O(^ACHSTXST(DUZ(2),1,""),-1)
  1.  I P'="" S ACHSBDT=$P(^ACHSTXST(DUZ(2),1,P,0),U,3)
  1.  ;if there is no last export, set the start date to 1/1/1800
  1.  I P="" S ACHSBDT=1000101
  1.  ;
  1.  ;now get the ending date.  There is no easy way to get it.
  1.  ;go through each child below the "AR" cross reference to get a
  1.  ;register number.  then use that register number to see when it
  1.  ;was last closed - that's the "W" cross reference.  As you get
  1.  ;each one, see if it's later than the end date you got and, if
  1.  ;it is, keep it.
  1.  ;
  1.  S DA=9999998-DT-1 F  S DA=$O(^ACHS(9,DUZ(2),"FY",ACHSCFY,"AR",DA)) Q:DA=""!('DA)  D
  1.  . S DCR="" F  S DCR=$O(^ACHS(9,DUZ(2),"FY",ACHSCFY,"AR",DA,DCR)) Q:DCR=""!('DCR)  D
  1.  .. S DAT=$G(^ACHS(9,DUZ(2),"FY",ACHSCFY,"W",DCR,0))
  1.  .. I $P(DAT,U,2)>ACHSEDT S ACHSEDT=$P(DAT,U,2)
  1.  .. Q
  1.  . Q
  1.  K DAT,DCR
  1.  I 'ACHSEDT W !!,*7,*7,"DCR REGISTER ERROR YOU MUST CLOSE YOUR REGISTERS FIRST" D RTRN^ACHS S STOP=1 Q
  1.  Q
  1.  ;
  1. INIT ;EP from ACHSTX2R
  1.  ;set up basic vars with default values and in other ways
  1.  ;get set to do this function
  1.  ;
  1.  ;S (ACHSDCR,ACHSEDT,ACHSBDT)=0,ACHSRR=""
  1.  ;
  1.  ;get the authorizing facility number.  will be in one of two
  1.  ;places in the AUTTLOC global:  either in the entry for this
  1.  ;facility, or in the entry for the area office facility. site
  1.  ;parm makes the difference
  1.  S ACHSAFAC=$P(^AUTTLOC(DUZ(2),0),U,10)
  1.  I $$PARM^ACHS(2,25)="Y" S ACHSAFAC=$P(^ACHSF(DUZ(2),0),U,12) I ACHSAFAC'="" S ACHSAFAC=$P($G(^AUTTLOC(ACHSAFAC,0)),U,10)
  1.  ;if it's not set by now, tell them about it and stop
  1.  I 'ACHSAFAC W !!,*7,*7,"AUTHORIZING FACILITY CODE ERROR  -  JOB CANCELLED" S STOP=1 Q
  1.  ;
  1.  ;we use a couple of parms several times, including a busy loop, so
  1.  ;lets load them once and keep the values around.  other parms we
  1.  ;just use once or twice
  1.  S ACHSF209=$$PARM^ACHS(2,9)="Y",ACHSF211=$$PARM^ACHS(2,11)="Y",ACHSF212=$$PARM^ACHS(2,12)="Y"
  1.  ;
  1.  ;parm 2,9 says whether we are export statistical data or not.
  1.  ;if so, go get some object class codes
  1.  I ACHSF209 D
  1.  . F ACHS="252F","254V" S ACHS(ACHS)=$O(^ACHS(3,DUZ(2),1,"B",ACHS,0))
  1.  . ; if this is a 638 facility, get even more object class codes
  1.  . I ACHSF638="Y" F ACHS="252G","252R","254D","254L","254M" S ACHS(ACHS)=$O(^ACHS(3,DUZ(2),1,"B",ACHS,0))
  1.  . Q
  1.  ;
  1.  ;this array keeps track of how many records of each type we create.
  1.  ;init the counts to zero
  1.  F ACHS=2:1:7 S ACHSRTYP(ACHS)=0
  1.  ;
  1.  Q
  1.  ;