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

ACHSTX.m

Go to the documentation of this file. 
  1. ACHSTX ; IHS/ITSC/PMF - EXPORT DATA (1/9) ;JUL 10, 2008
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5,7,13,14,16,21**;JUN 11,2001;Build 43
  1.  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Allow AlphaNumeric ACN.
  1.  ;IHS/SET/JVK ACHS*3.1*7 11/6/03 - Do not allow export unless ESig Que is empty
  1.  ;IHS/OIT/FCJ ACHS*3.1*13 7/16/07 Added test for UFMS export and record counts for export
  1.  ;IHS/OIT/FCJ ACHS*3.1*14 11/5/07 Added RE-Export process for UFMS
  1.  ;
  1.  ;perform test version instead?
  1.  ;S PMF="" F  S PMF=$O(^ACHS("Test Version",PMF)) Q:PMF=""  I $G(^(PMF))["ACHSTX" S PMF=^(PMF) Q;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  ;I PMF'="",$P(PMF,U,3) S PMF=$P(PMF,U,2) D @PMF K PMF Q;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  ;K PMF;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  ;
  1.  ;
  1.  I $$PARM^ACHS(0,8)="Y" Q:$$STATCHK
  1.  ;
  1.  K DIR  ;ACHS*3.1*16 IHS.OIT.FCJ ADDED LINE BECAUSE OF VAR BEING SET IN PAT REG AND NOT KILLED
  1.  I '$$LOCK^ACHS("^ACHSF(DUZ(2),""D"")","+") W *7,!! W:$$DIR^XBDIR("E","CHS DATA ENTRY IN PROGRESS -- JOB CANCELLED - <RETURN> TO CONTINUE") "" G KILL^ACHSTX8
  1.  ;ITSC/SET/JVK ACHS*3.1*7 11/6/03
  1.  I 'ACHSREEX,$D(^ACHSF("EQ",DUZ(2))) W *7,!! W:$$DIR^XBDIR("E","CHS DOCUMENTS REQUIRE E-SIG -- JOB CANCELLED - <RETURN> TO CONTINUE") "" G KILL^ACHSTX8
  1.  ;ACHS*3.1*14 IHS/OIT/FCJ ADDED NXT 2 LINES FOR TEST OF RE-EXPORT; COMMENTED OUT NXT 2 LINES FOR NEW FILE TYPE-ACHS*3.1*21
  1.  ;I $D(^ACHSDATA(0)),$P(^ACHSDATA(0),U,3)=DT,$P(^ACHSDATA(0),U)=$P(^AUTTLOC(DUZ(2),0),U,10) W !!?5,"A RE-EXPORT HAS ALREADY BEEN RAN TODAY, YOU WILL WRITE OVER",!?5,"THE FILE IF YOU CONTINUE."
  1.  ;S DIR(0)="E" D ^DIR G KILL^ACHSTX8:$D(DUOUT)!$D(DTOUT)
  1.  ;
  1.  D ^ACHSVAR
  1.  S ACHSRCT=0
  1.  ;ACHS*3.1*13 IHS/OIT/FCJ chg 7 to 8 in nxt line to set rec count for UFMS
  1.  F ACHS=2:1:8 S ACHSRTYP(ACHS)=0
  1. L2 ;
  1.  W !!,"Export data will be made for ",$$LOC^ACHS
  1.  G END:'$$DIR^XBDIR("Y","Is this Correct (Y/N) ","YES","","Export data will be made for "_$$LOC^ACHS,"",2)
  1.  G END:$D(DUOUT)!$D(DTOUT)
  1.  ;ACHS*3.1*21 COMMENTED OUT NXT 3 LINES
  1.  ;I $$EXFILE D  I '$$DIR^XBDIR("Y","Continue","N","","","^D HELP^ACHS(""FILEHELP"",""ACHSTX"")",1) G END
  1.  ;. W !!,*7
  1.  ;. D HELP^ACHS("FILEHELP","ACHSTX")
  1.  ;.Q
  1.  K DIC,X,Y
  1.  S DIC="^ACHSTXST("_DUZ(2)_",1,",DIC(0)="Z",X=DT
  1.  D ^DIC
  1.  K DIC,X
  1.  I Y>0,$P(Y(0),U,10)="N" G ^ACHSTXTT
  1.  I 'ACHSREEX,$D(^ACHSTXST("C",DT,DUZ(2))) G TXFEF^ACHSTX8
  1.  S ACHSARCO=$P(^ACHSF(DUZ(2),0),U,11)
  1.  ;I +ACHSARCO<1!($L(ACHSARCO)'=3) U IO(0) W *7,!!,"MISSING AREA CONTRACTING NUMBER - JOB CANCELLED" G ERROR;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  I '(ACHSARCO?3UN) U IO(0) W *7,!!,"Area Contracting Number is not 3 Upper-case Alpha-Numerics",!,"JOB CANCELLED" G ERROR ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  U IO(0)
  1.  S ACHSCRTN=""
  1. L3 ;
  1.  S ACHSMDAT=$$DTAO
  1.  G END:$D(DUOUT)!$D(DTOUT)
  1.  ;
  1.  ;03/01/02  pmf  clean up vars used to open and close a slave printer
  1.  ;K %ZIS
  1.  K %ZIS,ACHSPPC,ACHSPPO
  1.  ;
  1.  S %ZIS("A")="ENTER OUTPUT REPORT DEVICE # ",%ZIS="P"
  1.  W !
  1.  D ^%ZIS
  1.  G END:POP
  1.  I $D(IO("S")) D SLV^ACHSFU
  1.  S ACHSIO=IO,ACHSION=ION
  1.  D ^%ZISC,HOME^%ZIS
  1.  ;
  1.  ;ACHS*3.1*13 IHS/OIT/FCJ ADDED NXT 2 LINES; TEST FOR UFMS START DATE
  1.  S ACHSUSDT=$P(^ACHSF(DUZ(2),0),U,13)
  1.  ;ACHS*3.1*14 IHS/OIT/FCJ ADDED RE-EXPORT PROCESS FOR UFMS MV G AFTER TEST FOR ACHSREEX
  1.  ;S ACHSTXTY=$S(ACHSUSDT="":"S",ACHSUSDT>DT:"S",1:"U") G:ACHSTXTY="U" ^ACHSTXF 
  1.  S ACHSTXTY=$S(ACHSUSDT="":"S",ACHSUSDT>DT:"S",1:"U")
  1.  I ACHSREEX D ^ACHSTXAR Q
  1.  G:ACHSTXTY="U" ^ACHSTXF
  1.  D ^ACHSTX2
  1.  Q
  1.  ;
  1.  ;
  1.  ;
  1. KILLGLBS ;EP - Kill unsubscripted work globals.
  1.  ; ^ACHSDATA( - DHR (REC #2) All record types are set in this global to be sent to Area
  1.  ; ^ACHSTXPT( - Holds Patients to be exported. (Rec # 3)
  1.  ; ^ACHSTXVN( - Holds Vendor IENs to be exported. (Rec # 4)
  1.  ; ^ACHSTXOB( - Holds Document/Transaction to be exported. (Rec # 5)
  1.  ; ^ACHSTXPD( - Holds Paid Doc info to be exported to Area Office. (Rec # 6)
  1.  ; ^ACHSTXPG( - Holds Docs with statistical info to be exported to Data Center. (Rec # 7)
  1.  ;
  1.  N ACHS
  1.  F ACHS="^ACHSDATA","^ACHSTXPT","^ACHSTXVN","^ACHSTXOB","^ACHSTXPD","^ACHSTXPG" D
  1.  . W !,"Resetting ",ACHS,"(0)"
  1.  . ;2/25/02  pmf  changes for cache
  1.  . ;I $$KILLOK^ZIBGCHAR($P(ACHS,U,2)) W !,$$ERR^ZIBGCHAR($$KILLOK^ZIBGCHAR($P(ACHS,U,2)))
  1.  . ;K @ACHS
  1.  . S @(ACHS_"(0)")=""
  1.  . S ACHSG=ACHS_"(0)" F  S ACHSG=$Q(@ACHSG) Q:ACHSG=""  K @ACHSG
  1.  . Q
  1.  K ACHSG
  1.  Q
  1.  ;
  1. DTAO() ;EP - Prompt for date sent to Area Office.
  1.  Q $$DIR^XBDIR("D^"_DT_":"_$$HTFM^XLFDT($H+5),"ENTER DATE SENT TO AREA OFFICE ","T")
  1.  ;
  1. ERROR ;EP.
  1.  X:$D(ACHSPCC) ACHSPPC
  1.  U IO(0)
  1.  W !!,*7,*7,*7,"AN ERROR HAS OCCURRED DURING EXPORT PLEASE NOTIFY AREA OFFICE "
  1.  D ^%ZISC
  1.  G JOBABEND^ACHSTX8
  1.  ;
  1. END ;
  1.  W !!?10,"JOB TERMINATED BY OPERATOR"
  1.  G JOBABEND^ACHSTX8
  1.  ;
  1. STATCHK() ; Check 638 stat data prior to export.
  1.  D HELP^ACHSTX7X
  1.  I $$DIR^XBDIR("Y","Run pre-export data check first","YES","","","^D HELP^ACHSTX7X",2) D ^ACHSTX7X Q 1
  1.  Q 0
  1.  ;
  1. EXFILE() ; Does export file exist?
  1.  NEW X,Y,Z
  1.  S Y=$$ASF^ACHS(DUZ(2))
  1.  I $$OS^ACHS=2 S Y=$E(Y,3,6)
  1.  S Y="ACHS"_Y_"."_$$JDT^ACHS(DT)
  1.  I $$LIST^%ZISH($$EX^ACHS,Y,.X)
  1.  S Z=""
  1.  F  S Z=$O(X(Z)) Q:'Z  I X(Z)=Y Q
  1.  Q $S('Z:0,1:1)
  1.  ;
  1. FILEHELP ;EP -  ?? help text, from ACHS via DIR.
  1.  ;;
  1.  ;;     ***   AN EXPORT FILE FOR TODAY ALREADY EXISTS   ***
  1.  ;;
  1.  ;;An export file already exists in your export directory for today.
  1.  ;;You will overwrite the file if you continue.  If the file was
  1.  ;;correctly generated, the data in the file will be lost.  If you
  1.  ;;are certain that the data in the file was incorrectly generated,
  1.  ;;then proceed, forewarned.
  1.  ;;
  1.  ;;###