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

ACHSTXCK.m

Go to the documentation of this file. 
  1. ACHSTXCK ; IHS/ITSC/PMF - EXPORT DATA  [ 12/06/2002  10:36 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**5**;JUN 11, 2001
  1.  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002 - Keep test routine up to date.
  1.  ; this is the pre-export check list routine.
  1.  ; we do a whole series of things to prepare for exporting,
  1.  ; most of which may cause us to stop.
  1.  ;
  1.  ;OUTPUT:
  1.  ;    STOP       0 if not stopping
  1.  ;               1 if stopping and there is nothing else to do
  1.  ;               2 if stopping and !!!!!
  1.  ;
  1.  ;if this is a 638, ask them if they want to check the data
  1.  ;if they do, do it and stop
  1.  I ACHSF638 S STOP=$$STATCHK I STOP Q
  1.  ;
  1.  ;if anybody is fiddling with the POs and has them locked,
  1.  ;   say so and stop
  1.  S STOP='$$LOCK^ACHS("^ACHSF(DUZ(2),""D"")","+") I STOP W *7,!! W:$$DIR^XBDIR("E","CHS DATA ENTRY IN PROGRESS -- JOB CANCELLED - <RETURN> TO CONTINUE") "" Q
  1.  ;
  1.  ;verify the facility
  1.  W !!,"Export data will be made for ",$$LOC^ACHS
  1.  S STOP='$$DIR^XBDIR("Y","Is this Correct (Y/N) ","YES","","Export data will be made for "_$$LOC^ACHS,"",2) I $D(DUOUT)!$D(DTOUT) S STOP=1
  1.  I STOP Q
  1.  ;
  1.  ;if an export file for today already exists,
  1.  ;   tell them so and ask if the y want to continue
  1.  I $$EXFILE D  S STOP='$$DIR^XBDIR("Y","Continue","N","","","^D HELP^ACHS(""FILEHELP"",""ACHSTX"")",1) I STOP Q
  1.  . W !!,*7
  1.  . D HELP^ACHS("FILEHELP","ACHSTX")
  1.  .Q
  1.  ;
  1.  ;if not REEXporting, and export was done today, say so and stop
  1.  I 'ACHSREEX,$D(^ACHSTXST("C",DT,DUZ(2))) W !!,"EXPORT PROGRAM ALREADY RUN THIS DATE FOR THIS FACILITY",*7 S STOP=1 Q
  1.  ;
  1.  ;fetch the area contracting number and verify it
  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" S STOP=1 Q;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" S STOP=1 Q  ;IHS/SET/GTH ACHS*3.1*5 12/06/2002
  1.  ;
  1.  ;get the date
  1.  S ACHSMDAT=$$DTAO I $D(DUOUT)!$D(DTOUT) S STOP=1 Q
  1.  ;
  1.  ;clean up the work globals
  1.  D KILLGLBS
  1.  ;
  1.  ;get the device for the report
  1.  K %ZIS S %ZIS("A")="ENTER OUTPUT REPORT DEVICE # ",%ZIS="P" W !
  1.  D ^%ZIS
  1.  I POP S STOP=1 Q
  1.  ;
  1.  ;if it's a slave printer, set it up
  1.  I $D(IO("S")) D SLV^ACHSFU
  1.  S ACHSIO=IO
  1.  D ^%ZISC,HOME^%ZIS
  1.  ;
  1.  Q
  1.  ;
  1. KILLGLBS ;EP - Kill unsubscripted work globals.
  1.  ; ^ACHSDATA( - DHR (REC #2)
  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.  . I $$KILLOK^ZIBGCHAR($P(ACHS,U,2)) W !,$$ERR^ZIBGCHAR($$KILLOK^ZIBGCHAR($P(ACHS,U,2)))
  1.  . K @ACHS
  1.  . S @(ACHS_"(0)")=""
  1.  .Q
  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. 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.  ;;###