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

ACHSEXUT.m

Go to the documentation of this file.
  1. ACHSEXUT ; IHS/ITSC/PMF - GENERIC PRE EXPORT (SPLIT-OUT) PROCESSING PROGRAM ; [ 12/06/2002 10:36 AM ]
  1. ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5,22**;JUN 11, 2001;Build 43
  1. ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Clarify error message. Remove ref to non-package global.
  1. ;ACHS*3.1*22 OS test when writing to the directory
  1. ;
  1. FILESEL ;EP
  1. ;
  1. I $D(DTOUT) S ACHSOUT=1 Q
  1. D PARMCHK^ACHSTUT2
  1. I $D(ACHSJFLG) Q
  1. A9 ;S X="EXPORT PROCESSING OF "_ACHSTXNM_" DATA TO "_ACHSCCTR
  1. ;W !,?80-$L(X)/2,X,!
  1. ;F ACHSI=1:1:79 W "*"
  1. S ACHSXXX=""
  1. S:$D(ACHSHBCL) ACHSXXX=ACHSHBCL
  1. S ACHSXX="ibm"
  1. S:$L(ACHSHDNM>1) ACHSXX=ACHSHDNM_ACHSXXX
  1. S ACHSZFN=ACHSUXFP_ACHSXX,ACHSZOPT=1,ACHSFNLN=$L(ACHSZFN)
  1. K ACHSJFLG
  1. D ARCHLIST^ACHSARCH
  1. Q:$D(DUOUT)!$D(DTOUT)
  1. I $D(ACHSJFLG) Q
  1. S ACHSDTJL=$E(DT,2,3)_$$JDT^ACHS(DT,1)
  1. I '$D(ACHSFILE("N",ACHSDTJL)) S X=$C(97) G NAMEGEN
  1. FILEDSP ;
  1. W @IOF
  1. A10 ;
  1. W !!,"The following data has been processed TODAY: ",!
  1. A20 ;
  1. S (ACHSR,ACHSRR,ACHSSEQ)=0
  1. W !,"SEQ # ","# RCDS EXPORT - DATE FILE NAME - SFX OK-TX? COLOR",!!
  1. FILEDSPA ;
  1. S ACHSR=$O(ACHSFILE("N",ACHSDTJL,ACHSR))
  1. G DSPEND:ACHSR=""
  1. FILEDSPB ;
  1. S ACHSRR=$O(ACHSFILE("N",ACHSDTJL,ACHSR,ACHSRR))
  1. G FILEDSPA:ACHSRR=""
  1. S ACHSFNAM=$P(ACHSFILE(ACHSRR),U,2),ACHSXPT=0,ACHSXPT=$O(^AFSTXLOG(DUZ(2),1,"B",ACHSFNAM,ACHSXPT))
  1. ;I +ACHSXPT<1 S ACHSEMSG="ERROR IN TX/EXPORT DATA STRUCTURE -- NOTIFY SUPERVISOR ",ACHSJFLG=1 G JCANCEL;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. I +ACHSXPT<1 W !,"No entries for '",ACHSFNAM,"' for ",$$LOC^ACHS," in IHS DATA TRANSMISSION LOG file" G FILEDSPB ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. S ACHSZ=ACHSFILE(ACHSRR),ACHSTXST="N",$P(ACHSFILE(ACHSRR),U,3)="N"
  1. ;S:+ACHSXPT>0 ACHSTXST=$P(^AFSTXLOG(DUZ(2),1,ACHSXPT,0),U,4),$P(ACHSFILE(ACHSRR),U,3)=ACHSTXST;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. S:+ACHSXPT>0 ACHSTXST=$$GET1^DIQ(9002320.52,ACHSXPT_","_DUZ(2)_",",3,"I"),$P(ACHSFILE(ACHSRR),U,3)=ACHSTXST ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. ;S ACHSHCLR=$P(^AFSTXLOG(DUZ(2),1,ACHSXPT,0),U,5);IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. ;S ACHSHCLR=$S(ACHSHCLR="R":"RED",ACHSHCLR="B":"BLUE",1:"");IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. S ACHSHCLR=$$GET1^DIQ(9002320.52,ACHSXPT_","_DUZ(2)_",",3.11) ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1. S X=$P($P(ACHSFILE(ACHSRR),".",2),U,1)
  1. S Y=$$GDT^ACHS(X)
  1. S X=$P(ACHSFILE(ACHSRR),U,1),Z=X/81,X=$J(Z,0,0)
  1. S ACHSSEQ=ACHSSEQ+1
  1. W $J(ACHSSEQ,3),?6,$J(X,6),?17,Y
  1. S Z=$P(ACHSFILE(ACHSRR),U,2),ACHSZZ1=$P($P(ACHSZ,U,2),".",1),X=$P(Z,".",1)
  1. W ?33,$E(X,1,ACHSFNLN),?45,$E(X,ACHSFNLN+1,ACHSFNLN+1),?51,ACHSTXST,?57,ACHSHCLR,!
  1. G FILEDSPB
  1. ;
  1. DSPEND ;
  1. S Y=$$DIR^XBDIR("Y","Do you want to Continue","Y")
  1. I Y=0 S %="M9",ACHSEMSG=$P($T(@%^ACHSTCK1),";;",2),ACHSJFLG=1 G JCANCEL
  1. S X=$E(ACHSZZ1,$L(ACHSZZ1),$L(ACHSZZ1)),Y=$A(X),X=$C(Y+1)
  1. NAMEGEN ;
  1. ;S ACHSEXFN=ACHSZDIR_"/"_ACHSUXFP_ACHSXX_X_"."_ACHSDTJL,ACHSEXFS=ACHSUXFP_ACHSXX_X_"."_ACHSDTJL ;ACHS*3.1*22
  1. S ACHSEXFN=ACHSZDIR_$S($$OS^ACHS=2:"\",1:"/")_ACHSUXFP_ACHSXX_X_"."_ACHSDTJL ;ACHS*3.1*22 IHS.OIT.FCJ
  1. S ACHSEXFS=ACHSUXFP_ACHSXX_X_"."_ACHSDTJL ;ACHS*3.1*22
  1. Q
  1. ;
  1. JCANCEL ;
  1. U IO(0)
  1. W *7,!!,ACHSEMSG,!
  1. I $$DIR^XBDIR("E","Press RETURN...")
  1. S ACHSJFLG=1
  1. Q
  1. ;