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

BARDYSV4.m

Go to the documentation of this file. 
  1. BARDYSV4 ; IHS/SD/MAS,TPF - OMB - DAYS TO COLLECTION ; 02/09/2009
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**12,13,14,16**;OCT 22,2008
  1.  ;
  1.  ; 
  1.  ; IHS/SD/TMM  07/02/2009  M1  Routine ^BARDYSV2 created as a continuation of ^BARDYSVZ 
  1.  ;                             due to large routine size for SAC checker. 
  1.  ; IHS/SD/TMM  10/20/2009  M2  OMB Phase II modifications. (Create/copy from ^BARDYSV2)
  1.  ; IHS/SD/TMM  01/10/2010  M3  Record XBFLG value returned from ^XBGSAVE
  1.  ; IHS/SD/TMM  01/29/2010  M4  Tag TRANS moved from ^BARDYSV3 to ^BARDYSV5 due to 
  1.  ;                             routine size of ^BARDYSV3 and SAC checker requirement
  1.  ; IHS/SD/TMM  01/29/2010  M5  Run install report twice using diff date ranges
  1.  Q
  1.  ;
  1. SENDFILE(XBGL,XBFN) ; EP - CREATE FLAT FILE FOR UFMS USING XBGSAVE
  1.  S:$G(XBFN)="" XBFN="OMB.TST"
  1.  S:$G(XBGL)="" XBGL="BAROMB("  ;TEMP FILE KILLED AFTER FTP SEND. CAN'T USE ^XTMP($J
  1.  S XBQSHO=""
  1.  S XBF=$J                       ; Beginning 1st level numeric subscript
  1.  S XBE=$J                       ; Ending 1st level numeric subscript
  1.  S XBFLT=1                      ; indicates flat file
  1.  S XBMED="F"                    ; Flag indicates file as media
  1.  S XBCON=1                      ; Q if non-cononic
  1.  S XBS1="BAR OMB F"             ; ZISH SEND PARAMETERS entry
  1.  I $D(ZTQUEUED) S XBS1="BAR OMB B"
  1.  S XBQ="N"
  1.  S XBUF=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),16)),U)  ;A/R SITE PARAMETER FILE, OMB DIRECTORY
  1.  I XBUF="" D  Q
  1.  .W !!,"Before OMB files can be created a non-public directory must be created"
  1.  .W !,"on the Host File System. This directory must be entered in to A/R Site Parameter"
  1.  .W !,"field OMB DIRECTORY using the 'SPE    Site Parameter Edit' option"
  1.  .D ASKFORRT^BARUFUT
  1.  S XBFLG=0
  1.  ;
  1.  ;S XBS1=""  ;IF SET TO "" IT WON'T FTP ACROSS
  1.  ;
  1.  I XBUF="" D  Q
  1.  . S XBFLG=-1
  1.  . S XBFLG(1)="Missing OMB REPORT storage directory. Please check A/R OMB Parameters"
  1.  I IO=IO(0) W !!
  1.  ;
  1.  D ^XBGSAVE
  1.  Q
  1.  ;
  1. WRITE ;TEMP WRITE WHILE TESTING
  1.  N BARVLOC,BARVDA,BARBIL,VISITREC,BILLREC,TRANDT,TRANREC
  1.  S BARVLOC=0
  1.  F  S BARVLOC=$O(^BAROMB($J,BARVLOC)) Q:'BARVLOC  D
  1.  .S BARVDA=0
  1.  .F  S BARVDA=$O(^BAROMB($J,BARVLOC,BARVDA)) Q:'BARVDA  D
  1.  ..S VISITREC=^BAROMB($J,BARVLOC,BARVDA,"A VISITREC")
  1.  ..W !,BARVLOC,U,BARVDA,U,VISITREC
  1.  ..S BARBIL=0
  1.  ..F  S BARBIL=$O(^BAROMB($J,BARVLOC,BARVDA,"BILLREC",BARBIL)) Q:BARBIL=""  D
  1.  ...S BILLREC=^BAROMB($J,BARVLOC,BARVDA,"BILLREC",BARBIL)
  1.  ...W !,BARVLOC,U,BARVDA,U,BILLREC
  1.  ...S TRANDT=0
  1.  ...F  S BARBIL=$O(^BAROMB($J,BARVLOC,BARVDA,"TRANS REC",TRANDT)) Q:TRANDT=""  D
  1.  ....S TRANREC=^BAROMB($J,BARVLOC,BARVDA,"TRANS REC",TRANDT)
  1.  ....W !,BARVLOC,U,BARVDA,U,TRANREC
  1.  Q
  1.  ;
  1. ASKFNAME(BARFILE,BEGDATE,ENDDATE) ;EP - ASK FOR FILENAME (COPIED FROM BARUFUT1)
  1.  S BARFILE=$$GETFILNM(BEGDATE,ENDDATE)
  1.  W !!,"File will be created using the following name: ",BARFILE
  1.  Q 1
  1.  ;
  1. GETFILNM(BEGDATE,ENDDATE) ;EP - CREATE FILE NAME  (COPIED FROM BARUFUT1)
  1.  N FNROOT,FNEXT,FN,YR,DATE,TIME,DATETIME,BARPK,BARPT,BARP2,BARP3,DATERANG
  1.  S FNROOT="IHS_AR_OMB_"_DUZ_"_"_$$GETSUFAC()
  1.  S FNXREF=DUZ_"_"_$$GETSUFAC()
  1.  S BARV=$$VERSION^XPDUTL("BAR")
  1.  S BARP2=$$FILLSTR^BARUFUT1($P(BARV,".",2),2,"R","0")
  1.  S BARPK=$O(^DIC(9.4,"C","BAR",0))
  1.  S BARPK="IHS ACCOUNTS RECEIVABLE"
  1.  S BARPT=$$LAST^XPDUTL(BARPK,BARV)
  1.  S BARP3=$$FILLSTR^BARUFUT1(+BARPT,2,"R","0")
  1.  S FNXT=$P(BARV,".",1)_"."_BARP2_"."_BARP3
  1.  S FNEXT="_"_FNXT_".DAT"
  1.  S FN=FNROOT
  1. GETFILAG ;CHECK FOR FILE NAME ALREADY USED  (COPIED FROM BARUFUT1)
  1.  D NOW^%DTC
  1.  S YR=1700+$E(%,1,3)
  1.  S DATE=YR_$E(%,4,7)
  1.  S Y=% X ^DD("DD")
  1.  S TIME=$TR($P(Y,"@",2),":")
  1.  S:$L(TIME)=4 TIME=TIME_"00"
  1.  S DATETIME=DATE_"_"_TIME
  1.  S DATERANG="-"_BEGDATE_"-"_ENDDATE_"-"
  1.  S FN=FNROOT_"_"_DATETIME_DATERANG
  1.  S FN=FN_FNEXT
  1.  Q FN
  1.  ;
  1. GETSUFAC() ;EP;GIVEN DUZ(2)  (COPIED FROM BARUFUT1)
  1.  ;   get parent from parent/satellite file
  1.  N BARSAT,BARPAR,DA,ASUFAC
  1.  S BARSAT=DUZ(2)
  1.  S BARPAR=0                               ; Parent
  1.  ; check site active at DOS to ensure bill added to correct site
  1.  S DA=0
  1.  F  S DA=$O(^BAR(90052.06,DA)) Q:DA'>0  D  Q:BARPAR
  1.  . Q:'$D(^BAR(90052.06,DA,DA))  ; Pos Parent UNDEF Site Parameter
  1.  . Q:'$D(^BAR(90052.05,DA,BARSAT))  ; Satellite UNDEF Parent/Satellit
  1.  . Q:+$P($G(^BAR(90052.05,DA,BARSAT,0)),U,5)  ; Par/Sat not usable
  1.  . ; Q if sat NOT active at DT
  1.  . I DT<$P($G(^BAR(90052.05,DA,BARSAT,0)),U,6) Q
  1.  . ; Q if sat became NOT active before DT
  1.  . I $P($G(^BAR(90052.05,DA,BARSAT,0)),U,7),(DT>$P($G(^BAR(90052.05,DA,BARSAT,0)),U,7)) Q
  1.  . S BARPAR=$S(BARSAT:$P($G(^BAR(90052.05,DA,BARSAT,0)),U,3),1:"")
  1.  S ASUFAC=$$CURASUFC(BARPAR,DT)
  1.  Q ASUFAC
  1.  ;
  1. CURASUFC(LOCIEN,BARDOS) ;EP - GET CURRENT ASUFAC BASED ON 'DOS BEGIN' (#102) IN A/R BILL FILE (COPIED FROM BARUFUT1)
  1.  Q:LOCIEN="" "UNPOPL"
  1.  Q:BARDOS="" "UNPOPD"
  1.  N ASUFAC,BARDT,BARDTFLG
  1.  S ASUFAC=""
  1.  S BARDT=0
  1.  S BARDTFLG=0
  1.  S ASUFAC=$$GET1^DIQ(9999999.06,DUZ(2)_",",.12)  ;First take it from 'asufac index" field
  1.  ;if not, check class multiple
  1.  I 'ASUFAC D
  1.  .F  S BARDT=$O(^AUTTLOC(LOCIEN,11,BARDT)) Q:BARDT=""!(BARDTFLG=1)  D
  1.  ..I BARDOS>$P($G(^AUTTLOC(LOCIEN,11,BARDT,0)),U) D
  1.  ...S ASUFAC=$P($G(^AUTTLOC(LOCIEN,11,BARDT,0)),U,6)
  1.  ...S BARDTFLG=1
  1.  ;S:ASUFAC="" ASUFAC=$$GET1^DIQ(9999999.06,DUZ(2)_",",.12)
  1.  Q ASUFAC
  1.  ;
  1. INSTALL ;EP - Run two times using different date range when BAR*1.8*16 installed ;M5*ADD*TMM
  1.  S BEGDATE=3081001                ;M5*ADD*TMM
  1.  S ENDDATE=3090930                ;M5*ADD*TMM
  1.  D INST                           ;M5*ADD*TMM
  1.  S BEGDATE=3091001                ;M5*ADD*TMM
  1.  S ENDDATE=3100131                ;M5*ADD*TMM
  1.  D INST                           ;M5*ADD*TMM
  1.  Q
  1.  ;
  1. INST ;EP - Run once when patch installed BAR*1.8*14         ;M5*ADD*TMM
  1.  ;INSTALL ;EP - Run once when patch installed BAR*1.8*14    ;M5*DEL*TMM
  1.  I '$$IHS^BARDYSV3(DUZ(2)) Q        ;***Should this be installed at non-IHS facilities?
  1.  D INIT^BARDYSV3
  1.  ;S BEGDATE=3081001               ;M5*DEL*TMM
  1.  ;S ENDDATE=3090930               ;M5*DEL*TMM
  1.  D NOW^%DTC
  1.  S ^BARTMP("BARDYSV3",0,"INSTALL STARTED",DUZ(2),%)=BEGDATE_U_ENDDATE
  1.  D VISITS^BARDYSV5(BEGDATE,ENDDATE)
  1.  D BILLS^BARDYSV3(BEGDATE,ENDDATE)                            ;M2
  1.  ;D TRANS^BARDYSV3(BEGDATE,ENDDATE)                           ;M2  ;M4*DEL*TMM
  1.  D TRANS^BARDYSV5(BEGDATE,ENDDATE)                            ;M2  ;M4*ADD*TMM
  1.  S ^BARTMP("BARDYSV3",0,"INSTALL COMPLETED",DUZ(2),%)="OMB PHASE II - Data Extracted, Ready to send"
  1.  S RC=$$ASKFNAME(.BARFILE,BEGDATE,ENDDATE)
  1.  D SENDFILE("BAROMB(",BARFILE)               ;M1 BAR*1.8*13 TMM 
  1.  D NOW^%DTC
  1.  ;I $G(XBFLG)'=0 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETED",DUZ(2),%,1)="Global copy of ^BAROMB Failed"_"^"_$G(XBFLG(1))   ;M2 ;M3*DEL*TMM
  1.  ;I $G(XBFLG)=-1 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETED",DUZ(2),%,2)=$G(XBFLG(1))                                    ;M2 ;M3*DEL*TMM
  1.  ;I $G(XBFLG)=0 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETE",DUZ(2),%,3)="Global copy ^BAROMB successful"                     ;M2 ;M3*DEL*TMM
  1.  I $G(XBFLG)'=0 S ^BARTMP("BARDYSV3",0,"INSTALL COMPLETED",DUZ(2),%,1)="Global copy of ^BAROMB Failed"_"^"_XBFLG_"^"_$G(XBFLG(1))   ;M2  ;M3*ADD*TMM
  1.  I $G(XBFLG)=-1 S ^BARTMP("BARDYSV3",0,"INSTALL COMPLETED",DUZ(2),%,2)=$G(XBFLG)_"^"_$G(XBFLG(1))                                   ;M2  ;M3*ADD*TMM
  1.  I $G(XBFLG)=0 S ^BARTMP("BARDYSV3",0,"INSTALL COMPLETE",DUZ(2),%,3)="Global copy ^BAROMB successful"                               ;M2  ;M3*ADD*TMM
  1.  Q