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

ACHSTXTT.m

Go to the documentation of this file.
  1. ACHSTXTT ; IHS/ITSC/TPF/PMF - TRANSFER ACHSDATA GLOBAL TO EXPORT MEDIA ;
  1. ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**25**;JUN 11, 2001;Build 43
  1. ;
  1. D LINES^ACHSFU,^ACHSVAR
  1. L1 ;
  1. W @IOF,!,ACHS("*"),!,"*",?23,"COPY CHS TX DATA FOR EXPORT",?78,"*",!,ACHS("*"),!
  1. I '$D(^ACHSDATA(0)) W !?25,"CHS EXPORT RECORDS NOT FOUND" G END
  1. L2 ;
  1. W !?10,"CHS EXPORT DATA FOUND FOR : ",$P(^ACHSDATA(0),U,2)
  1. W !!?25,"EXPORT RUN DATE",?50,"=",?55,$$FMTE^XLFDT($P(^ACHSDATA(0),U,3))
  1. W !?25,"BEGINNING ADD/UPD DATE",?50,"=",?55,$$FMTE^XLFDT($P(^ACHSDATA(0),U,4))
  1. W !?25,"ENDING ADD/UPD DATE",?50,"=",?55,$$FMTE^XLFDT($P(^ACHSDATA(0),U,5))
  1. W !?25,"NUMB OF DATA RECORDS",?50,"=",?55,$P(^ACHSDATA(0),U,7)
  1. I '$D(^ACHSTXST("C",$P(^ACHSDATA(0),U,3),DUZ(2))) W !!,"CHS TX DATA DOES NOT MATCH LAST EXPORT DATE & FACILITY",*7 G END
  1. S DA=$P(^ACHSTXST(DUZ(2),1,0),U,3)
  1. I '$D(^ACHSTXST(DUZ(2),1,DA,0)) W !!,"CHS TX STATUS NODE FOR THIS SITE IS MISSING",*7 G END
  1. I $P(^ACHSTXST(DUZ(2),1,DA,0),U,10)="N" W !,*7,?27,"RECOPYING EXPORT DATA TO DATA MEDIA"
  1. L3 ;
  1. S ACHSMDAT=$$DTAO^ACHSTX
  1. G END:$D(DUOUT)!$D(DTOUT)
  1. S %=$$DIR^XBDIR("Y","ARE ALL ENTRIES CORRECT (Y/N)")
  1. G END:$D(DTOUT)!$D(DUOUT),L1:'%
  1. S $P(^ACHSDATA(0),U,9)=ACHSMDAT,$P(^ACHSDATA(0),U,8)=""
  1. L5 ;
  1. S XBGL="ACHSDATA",XBNAR="CONTRACT HEALTH export data"
  1. S XBMED="F" ;ACHS*3.1*25
  1. I $P(^AUTTSITE(1,0),U,14)'="",$D(^%ZIB(9888888.93,"B",$P(^AUTTSITE(1,0),U,14))) S XBS1=$P(^AUTTSITE(1,0),U,14) ;ACHS*3.1*25
  1. D ^XBGSAVE
  1. I XBFLG G END
  1. S $P(^ACHSTXST(DUZ(2),1,DA,0),U,10)="Y",$P(^(0),U,7)=ACHSMDAT,$P(^ACHSTXST(DUZ(2),1,DA,0),U,6)=""
  1. W !!,"NORMAL END OF JOB"
  1. END ; Show results, ask EOP, kill vars, quit.
  1. I $D(XBFLG),XBFLG W !!,XBFLG(1),!!
  1. I $$DIR^XBDIR("E","Press RETURN...")
  1. K %DT,ACHS,XBOK,ACHSMDAT,DA,DIR
  1. Q
  1. ;