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

BARPMUP2.m

Go to the documentation of this file. 
  1. BARPMUP2 ; IHS/SD/LSL - MANUAL UPLOAD PROCESS ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;*24*;OCT 26, 2005;Build 69
  1.  ;
  1.  ; IHS/SD/LSL - 12/12/02 - V1.7 - NHA-0601-180049
  1.  ;      Modified to find the correct bill in 3P.  Modified routine
  1.  ;      clarity and documentation.
  1.  ;
  1.  ; IHS/SD/LSL - 05/08/03 - V1.7 Patch 1 - IM10668
  1.  ;      Modified to not previous run if DUZ(2) not there.
  1.  ;
  1.  ; IHS/SD/LSL - 06/09/03 - V1.7 Patch 1
  1.  ;      Modified to set BAR("OPT") to menu option to disquinish
  1.  ;      Upload by date range during AR Bill creation
  1.  ;
  1.  ; *********************************************************************
  1.  ;
  1.  ;** Manual upload process by approval dates
  1.  ;
  1.  ;IHS/SD/SDR JULY 2013 belcourt HEAT118656 - BAR*1.8*.24
  1.  ;IHS/SD/POT LOCK (MAKE UPL PROCESS EXCLUSIVE)  - BAR*1.8*.24
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EN ;EP - entry
  1.  ;START NEW CODE START BAR*1.8*.24
  1.  L +@($T(+0)):0
  1.  E  W !!!,"THE UPLOAD OPTION IS BEING ACCESSED BY ANOTHER USER. TRY AGAIN LATER.",! D EOP^BARUTL(1) Q  ;ALLOW ONLY ONE INSTANCE RUNNING
  1.  ;END OF NEW CODE BAR*1.8*.24
  1.  D ^BARVKL0
  1.  S BARESIG=""
  1.  D SIG^XUSESIG                             ; Get electronic sig
  1.  Q:X1=""
  1.  I '$D(BARUSR) D INIT^BARUTL               ; Initialize A/R environment
  1.  S BAROPT="Upload by date"                 ; LSL - V1.7 Patch 1
  1.  S (BAR("CONT"),BARERR)=0
  1.  W !
  1.  I ($D(^BARTMP("BARUP"))&($D(^BARTMP("BARUP","DUZ(2)")))) D  Q  ;Previous run detected
  1.  . W $$EN^BARVDF("IOF"),!,"A PREVIOUS RUN HAS BEEN DETECTED",!
  1.  . D STAT^BARPMUP4                         ; Display status of last run
  1.  . I $E(BARUSTAT)="C" D ASKNEW Q           ; Previous run completed
  1.  . D CONT                                  ; Continue last run?
  1.  . Q
  1.  D NEW                                     ; Begin new run
  1.  D EXIT
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. ASKNEW ;
  1.  ; Previous run complete, ask if new one
  1.  W !,"The previous run has completed",!
  1.  K DIR
  1.  S DIR("A")="Do you want to do a new run"
  1.  S DIR("B")="NO"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  K DIR
  1.  I Y'=1 Q
  1.  W !!,*7,"You MUST write down the BAD bills found for follow up!"
  1.  W !,"They did not upload into A/R",!
  1.  K DIR
  1.  S DIR("A")="Sure you are ready to restart"
  1.  S DIR("B")="NO"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  K DIR
  1.  I Y'=1 Q
  1.  W !
  1.  K ^BARTMP("BARUP")
  1.  D NEW
  1.  D EXIT
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. CONT ;
  1.  ; Continue previous run
  1.  K DIR
  1.  S DIR(0)="Y"
  1.  S DIR("A")="CONTINUE WITH RESTART"
  1.  S DIR("B")="NO"
  1.  D ^DIR
  1.  K DIR
  1.  I 'Y D  Q
  1.  . W !,"NO RESTART OF UPLOAD",!
  1.  . D DX
  1.  ; Variables obtained from result of STAT^BARPMUP4
  1.  S BAR("CONT")=1
  1.  S BARQ("RC")="RESUME^BARPMUP2"
  1.  S BARQ("RP")="DX^BARPMUP2"
  1.  S BARQ("NS")="BAR"
  1.  S BARQ("RX")="EXIT^BARPMUP2"
  1.  D ^BARDBQUE
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DX ;
  1.  S ^BARTMP("BARUP","STATUS")="COMPLETE"
  1.  W $$EN^BARVDF("IOF"),!,"This run is complete.  Here's the status",!
  1.  D STAT^BARPMUP4
  1.  ;W !!,+BARCNT_" 3P Bills updated to A/R"  ;IHS/SD/SDR belcourt HEAT118656
  1.  W !!,(+BARCNT-($O(^BARTMP("BARUP","ERRORS",""),-1)))_" 3P Bills updated to A/R"  ;IHS/SD/SDR belcourt HEAT118656
  1.  D EOP^BARUTL(1)
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. NEW ;
  1.  ; Start new run
  1.  D GETDOS                                  ; Ask date range
  1.  Q:BARSTART<1                              ; Date range not entered
  1.  D SCANMSG                                 ; Ready? message
  1.  I Y'=1 Q                                  ; Not ready
  1.  D SCAN                                    ; Scan for 3p Bills
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. GETDOS ;EP
  1.  S BARSTART=$$DATE^BARDUTL(1)
  1.  I BARSTART<1 Q
  1.  ;
  1. G1 ;
  1.  S BAREND=$$DATE^BARDUTL(2)
  1.  I BAREND<1 W ! G GETDOS
  1.  I BAREND<BARSTART D  G GETDOS
  1.  .W *7
  1.  .W !!,"The END date must not be before the START date.",!
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SCANMSG ;
  1.  W !!,"This process will scan the 3P BILL file and extract all bills with approval"
  1.  W !,"dates between ",$$SDT^BARDUTL(BARSTART)," and ",$$SDT^BARDUTL(BAREND)
  1.  W ". The process will check to make"
  1.  W !,"sure that a bill that has already been uploaded will not be duplicated.",!
  1.  K DIR
  1.  S DIR("A")="Are you ready to start"
  1.  S DIR("B")="NO"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  K DIR
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. SCAN ;
  1.  W !!,"Starting scan process... "
  1.  N BARDA,DIC,BARBAL,BARBLNM
  1.  S BARCNT=0,BARDA=0,BARBLNM=""
  1.  S BARSTART=BARSTART-.1  ;IHS/SD/SDR belcourt HEAT118656
  1.  S BAREND=BAREND+.999999  ;IHS/SD/SDR belcourt HEAT118656
  1.  S ^BARTMP("BARUP","PREVIOUS START DATE")=BARSTART
  1.  S ^BARTMP("BARUP","PREVIOUS END DATE")=BAREND
  1.  S BARQ("RC")="RESUME^BARPMUP2"
  1.  S BARQ("RP")="DX^BARPMUP2"
  1.  S BARQ("NS")="BAR"
  1.  S BARQ("RX")="EXIT^BARPMUP2"
  1.  D ^BARDBQUE
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. RESUME ;
  1.  ;  Loop DUZ(2)
  1.  I $G(^BARTMP("STOP")) Q
  1.  S X="ERROR^BARPMUP2",@^%ZOSF("TRAP")
  1.  S ^BARTMP("BARUP","STATUS")="IN PROCESS"
  1.  S BARHOLD=DUZ(2)
  1.  S ^BARTMP("BARUP","STARTDUZ(2)")=DUZ(2)  ;IHS/SD/SDR belcourt HEAT118656
  1.  S BARERR=0  ;IHS/SD/SDR belcourt HEAT118656
  1.  ; loop 3P Bill file DUZ(2)
  1.  S DUZ(2)=0
  1.  S:+BAR("CONT") DUZ(2)=$O(^ABMDBILL(^BARTMP("BARUP","DUZ(2)")),-1)
  1.  F  S DUZ(2)=$O(^ABMDBILL(DUZ(2))) Q:'+DUZ(2)  D LOOPDT
  1.  S DUZ(2)=BARHOLD
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. LOOPDT ;
  1.  ; Loop Date Approved x-ref on 3P bill for selected date range
  1.  S ^BARTMP("BARUP","DUZ(2)")=DUZ(2)
  1.  S BARAPDT=$O(^ABMDBILL(DUZ(2),"AP",BARSTART),-1)
  1.  S:+BAR("CONT") BARAPDT=$O(^ABMDBILL(DUZ(2),"AP",^BARTMP("BARUP","LAST AP DATE",DUZ(2))),-1)
  1.  F  S BARAPDT=$O(^ABMDBILL(DUZ(2),"AP",BARAPDT)) Q:'+BARAPDT!(BARAPDT>BAREND)  D LOOPBILL
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. LOOPBILL ;
  1.  ;
  1.  S ^BARTMP("BARUP","LAST AP DATE",DUZ(2))=BARAPDT
  1.  S BARDA=0
  1.  ;S:+BAR("CONT") BARDA=^BARTMP("BARUP","LAST BILL IEN",DUZ(2))  ;IHS/SD/SDR belcourt HEAT118656
  1.  S BARDA=+$G(^BARTMP("BARUP","LAST BILL IEN",DUZ(2)))  ;IHS/SD/SDR belcourt HEAT118656
  1.  F  S BARDA=$O(^ABMDBILL(DUZ(2),"AP",BARAPDT,BARDA)) Q:'+BARDA  D DATA
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. DATA ;
  1.  ; Gather data and upload to A/R
  1.  D NOW^%DTC
  1.  S Y=%
  1.  D DD^%DT
  1.  S (^BARTMP("BARUP","LAST DATE"),BARDTS)=Y
  1.  S ^BARTMP("BARUP","LAST BILL IEN",DUZ(2))=BARDA
  1.  Q:'$D(^ABMDBILL(DUZ(2),BARDA,0))          ; No data on 3P bill, Q
  1.  S (BARBAL,BARBLNM)=""
  1.  S BARSTAT=$$GET1^DIQ(9002274.4,BARDA,.04,"I")
  1.  ; Only want approved, billed, partial payment, or transfered bills
  1.  ;Q:$S(BARSTAT="A":0,BARSTAT="B":0,BARSTAT="P":0,BARSTAT="T":0,1:1)  ;IHS/SD/SDR belcourt HEAT118656- BAR*1.8*.24
  1.  ;all bill statuses EXCEPT REVIEWED
  1.  Q:$S(BARSTAT="A":0,BARSTAT="B":0,BARSTAT="P":0,BARSTAT="T":0,BARSTAT="C":0,BARSTAT="X":0,1:1)  ;IHS/SD/SDR belcourt HEAT118656- BAR*1.8*.24
  1.  S BARBLNM=$$GET1^DIQ(9002274.4,BARDA,.01)
  1.  ;--------------------------------------
  1.  I BARBLNM]"" I $D(^BARTMP("BARUP","BAR_ERRORS",BARBLNM)) D  Q
  1.  . W !,"BILL # ",BARBLNM," NOT UPLOADED DUE TO: ",$G(^BARTMP("BARUP","ERROR",BARBLNM))
  1.  . Q
  1.  S ^BARTMP("BARUP","LAST BILL NAME",DUZ(2))=BARBLNM
  1.  S BAREXIST=$$FINDAR(BARBLNM)              ; Bill already in A/R?
  1.  I +BAREXIST D ERROR2 Q                    ; It is, add  error list, q
  1.  S DA=BARDA                                ; IEN to 3P bill
  1.  D EXT^ABMAPASS                            ; Upload to A/R
  1.  S BARCNT=BARCNT+1
  1.  S ^BARTMP("BARUP","COUNT")=BARCNT
  1.  I BARCNT#25=0,$E(IOST)="C",'$D(ZTQUEUED) W "."
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. FINDAR(BARBLNM) ;
  1.  ; Find the 3P bill in A/R
  1.  ; If it exists in any A/R environment, put on ERROR list
  1.  ; Pass in Bill number
  1.  ; Pass out 1 if found, 0 if not found
  1.  N BARDTMP,BARSNM,BARBTMP
  1.  S BARBTMP=-1
  1.  S BARSNM=$P(BARBLNM,"-")
  1.  I $L(BARBLNM)=$L(BARSNM) S BARSNM=BARSNM_" "  ;IHS/SD/SDR belcourt HEAT118656
  1.  S BARDTMP=0
  1.  F  S BARDTMP=$O(^BARBL(BARDTMP)) Q:('+BARDTMP!(BARBTMP>0))  D FINDAR2
  1.  I BARBTMP>0 Q 1
  1.  Q 0
  1.  ; *********************************************************************
  1.  ;
  1. FINDAR2 ;
  1.  N BARNNM
  1.  S BARNNM=$O(^BARBL(BARDTMP,"B",BARSNM),-1)
  1.  F  S BARNNM=$O(^BARBL(BARDTMP,"B",BARNNM)) Q:(($P(BARNNM,"-")'=BARSNM)!(BARBTMP>0))  D FINDAR3
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. FINDAR3 ;
  1.  S BARDATMP=0
  1.  F  S BARDATMP=$O(^BARBL(BARDTMP,"B",BARNNM,BARDATMP)) Q:('+BARDATMP!(BARBTMP>0))  S BARBTMP=BARDATMP
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. ERROR ;PROCESS AN ERROR
  1.  S BARERR=BARERR+1
  1.  ;N BARTMP  ;IHS/SD/SDR 10/28/13 belcourt HEAT118656
  1.  S BARTMP=""  ;IHS/SD/SDR 10/28/13 belcourt HEAT118656 
  1.  S ^BARTMP("BARUP","ERRORS",BARERR)=BARBLNM_U_BARDA_U_$$GET1^DIQ(4,DUZ(2),.01)
  1.  ;S BARTMP=BARBLNM_U_BARDA_U_DUZ(2)_U_$ZE ;NEW CODE ADDED $ZE
  1.  S BARTMP=BARBLNM_U_BARDA_U_DUZ(2) ;_U_$ZE ;- BAR*1.8*.24
  1.  S ^BARTMP("BARUP","ERRORS",BARERR)=BARTMP
  1.  S X="ERROR^BARPMUP2",@^%ZOSF("TRAP")
  1.  G RESUME
  1.  ; *********************************************************************
  1.  ;
  1. ERROR2 ;
  1.  ; Process bill already exists error.
  1.  S BARERR=BARERR+1
  1.  S ^BARTMP("BARUP","ERRORS",BARERR)=BARBLNM_U_BARDA_U_"ALREADY IN A/R"
  1.  S X="ERROR^BARPMUP2",@^%ZOSF("TRAP")
  1.  Q
  1.  ; *********************************************************************
  1.  ;
  1. EXIT ;
  1.  S X=^%ZOSF("ERRTN"),@^%ZOSF("TRAP")
  1.  D ^BARVKL0
  1.  L -@($T(+0)) ;LINE ADDED BAR*1.8*.24
  1.  Q  ;EOR