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

ACRFDHR5.m

Go to the documentation of this file. 
  1. ACRFDHR5 ;IHS/OIRM/DSD/AEF - RECOVER UNTRANSMITTED DHRS [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1.  ;
  1.  ;This routine will loop through the FMS Document History Record file
  1.  ;and find those DHRs that have not been transmitted, i.e., 
  1.  ;don't have an entry in the UNIX EXPORT FILE field and put them into
  1.  ;ARMS-BLUE or ARMS-RED batches for transmission to CORE.
  1.  ;
  1.  ;Payment DHRs can be recovered by reopening and re-exporting the
  1.  ;payment batch.
  1.  ;
  1. EN ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  N ACRASK,ACRRANGE
  1.  D TXT
  1.  I $$CHK D  Q
  1.  . W !!,"Records exist in ARMS-BLUE and/or ARMS-RED batches.  These"
  1.  . W !,"records must be cleared before running this option."
  1.  . W !
  1.  D ASK(.ACRASK)
  1.  Q:'ACRASK
  1.  I ACRASK=1 D DATE(ACRASK,.ACRRANGE)
  1.  I ACRASK=2 D IEN(ACRASK,.ACRRANGE)
  1.  Q:'ACRRANGE
  1.  D DATA(ACRRANGE)
  1.  Q
  1. ASK(ACRASK)        ;
  1.  ;----- RETURNS SORT PREFERENCE, BY DATE OR IEN
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S ACRASK=0
  1.  S DIR(0)="S^1:BY DATE GENERATED;2:BY IEN NUMBER"
  1.  S DIR("A")="SORT BY"
  1.  S DIR("?")="Enter 1 if you want to find DHRs by DATE GENERATED, 2 if you want to find DHRs by IEN number"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DIRUT))!($D(DUOUT))
  1.  S ACRASK=Y
  1.  Q
  1. DATE(ACRASK,ACRRANGE)        ;
  1.  ;----- ASK AND RETURN DATE RANGE
  1.  ;
  1. DATELOOP ;
  1.  N ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S ACRRANGE=""
  1.  W !
  1.  S DIR(0)="DO^::E"
  1.  S DIR("A")="Start with DATE GENERATED"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DIRUT))!($D(DUOUT))
  1.  S ACRBEG=Y
  1.  I ACRBEG<3000701 D  G DATELOOP
  1.  . W !?5,"Cannot recover DHRs generated before July 1, 2000"
  1.  S DIR("A")="End with DATE GENERATED"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DIRUT))!($D(DUOUT))
  1.  S ACREND=Y
  1.  I ACRBEG>ACREND D  G DATELOOP
  1.  . W !?5,"ENDING DATE cannot be less than BEGINNING DATE"
  1.  S ACRRANGE=ACRASK_U_ACRBEG_U_ACREND
  1.  Q
  1. IEN(ACRASK,ACRRANGE)         ;
  1.  ;----- ASK AND RETURN IEN RANGE
  1.  ;
  1.  ;RESTRICT TO DATES AFTER 7-1-00
  1. IENLOOP ;
  1.  ;
  1.  N ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S ACRRANGE=""
  1.  W !
  1.  S DIR(0)="N"
  1.  S DIR("A")="Begin with IEN NUMBER"
  1.  S DIR("?")="Enter Iternal Entry Number (IEN)"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DIRUT))!($D(DUOUT))
  1.  S ACRBEG=Y
  1.  S DIR("A")="End with IEN NUMBER"
  1.  D ^DIR
  1.  Q:$D(DTOUT)!($D(DIRUT))!($D(DUOUT))
  1.  S ACREND=Y
  1.  I ACRBEG>ACREND D  G IENLOOP
  1.  . W !?5,"ENDING IEN cannot be less than BEGINNING IEN"
  1.  S ACRRANGE=ACRASK_U_ACRBEG_U_ACREND
  1.  Q
  1. DATA(ACRRANGE)     ;
  1.  ;----- GATHERS DHR DATA AND PUTS INTO ARMS BATCH
  1.  ;
  1.  I $P(ACRRANGE,U)=1 D LOOP1(ACRRANGE)
  1.  I $P(ACRRANGE,U)=2 D LOOP2(ACRRANGE)
  1.  Q
  1. LOOP1(ACRRANGE)    ;
  1.  ;----- LOOP THROUGH DATE GENERATED XREF
  1.  ;
  1.  N ACRCNT,ACRDATE,ACREND,ACRIEN
  1.  S ACRDATE=$P(ACRRANGE,U,2)
  1.  S ACREND=$P(ACRRANGE,U,3)
  1.  S ACRDATE=ACRDATE-1
  1.  F  S ACRDATE=$O(^ACRDHR("D",ACRDATE)) Q:'ACRDATE  Q:ACRDATE>ACREND  D
  1.  . S ACRIEN=0
  1.  . F  S ACRIEN=$O(^ACRDHR("D",ACRDATE,ACRIEN)) Q:'ACRIEN  D
  1.  . . Q:$P($G(^ACRDHR(ACRIEN,20)),U,7)]""
  1.  . . D SET(ACRIEN)
  1.  I $G(ACRCNT) D
  1.  . W !!?5,ACRCNT," records have been placed in ARMS batch"
  1.  I '$G(ACRCNT) D
  1.  . W !!?5,"No records found      "
  1.  H 3
  1.  Q
  1. LOOP2(ACRRANGE)    ;
  1.  ;----- LOOP THROUGH IENS
  1.  ;
  1.  N ACRCNT,ACREND,ACRIEN
  1.  S ACRIEN=$P(ACRRANGE,U,2)
  1.  S ACREND=$P(ACRRANGE,U,3)
  1.  S ACRIEN=ACRIEN-1
  1.  F  S ACRIEN=$O(^ACRDHR(ACRIEN)) Q:'ACRIEN  Q:ACRIEN>ACREND  D
  1.  . Q:$P($G(^ACRDHR(ACRIEN,0)),U,2)<3000701
  1.  . Q:$P($G(^ACRDHR(ACRIEN,20)),U,7)]""
  1.  . D SET(ACRIEN)
  1.  I $G(ACRCNT) D
  1.  . W !!?5,ACRCNT," records have been placed in ARMS batch"
  1.  I '$G(ACRCNT) D
  1.  . W !!?5,"No records found"
  1.  H 3
  1.  Q
  1. SET(ACRIEN)        ;
  1.  ;----- SET DHRS INTO ARMS BATCH
  1.  ;
  1.  ;      This subroutine calls DHRRCD^ACRFDHR1 to add an entry to the
  1.  ;      ARMS-BLUE or ARMS-RED batch in the DHR Data Records file.
  1.  ;      It sets up the variables needed for this call.
  1.  ;
  1.  ;      ACR3     =  TRANSACTION TYPE
  1.  ;      ACRDEPT  =  DEPARTMENT ACCOUNT
  1.  ;      ACRDOC0  =  ZERO NODE OF DOCUMENT IN FMS DOCUMENT FILE
  1.  ;      ACRDR    =  DR EDIT STRING
  1.  ;      ACRFY    =  FISCAL YEAR OF FUNDS FROM DEPARTMENT ACCOUNT
  1.  ;      ACRIV    =  PAYMENT TRANSACTION INDICATOR
  1.  ;      ACRRECOV =  RECOVERED DHRS INDICATOR (COMING THRU THIS ROUTINE)
  1.  ;      ACRREF   =  DOCUMENT REFERENCE CODE
  1.  ;
  1.  N ACR3,ACRDATA,ACRDEPT,ACRDOC0,ACRDR,ACRFY,ACRIV,ACRRECOV,ACRREF,X
  1.  S ACRRECOV=1
  1.  I '$G(ACRACPT) D
  1.  . S X=$P($G(^ACRSYS(1,"DT1")),U,13)
  1.  . Q:'X
  1.  . S ACRACPT=$P($G(^AUTTACPT(X,0)),U)
  1.  S ACRDOC0=$P($G(^ACRDHR(ACRIEN,0)),U,4)
  1.  I ACRDOC0 S ACRDOC0=^ACRDOC(ACRDOC0,0) D
  1.  . S ACRDEPT=$P(ACRDOC0,U,6)
  1.  I $G(ACRDEPT) S ACRFY=$P($G(^ACRLOCB(ACRDEPT,"DT")),U)
  1.  S ACRDATA=^ACRDHR(ACRIEN,1)
  1.  S ACR3=$P(ACRDATA,U,3)
  1.  S ACRIV="PAY"
  1.  I ACR3="050" S ACRIV=""
  1.  I ACR3="081" S ACRIV=""
  1.  S ACRREF=$P(ACRDATA,U,6)
  1.  I ACRREF="" S ACRREF=$P(ACRDATA,U,8)
  1.  S ACRDR="1////"_$P(ACRDATA,U)
  1.  S ACRDR=ACRDR_";2////"_$P(ACRDATA,U,2)
  1.  S ACRDR=ACRDR_";3////"_$P(ACRDATA,U,3)
  1.  S ACRDR=ACRDR_";4////"_$P(ACRDATA,U,4)
  1.  S ACRDR=ACRDR_";5////"_$P(ACRDATA,U,5)
  1.  S ACRDR=ACRDR_";6////"_$P(ACRDATA,U,6)
  1.  S ACRDR=ACRDR_";7////"_$P(ACRDATA,U,7)
  1.  S ACRDR=ACRDR_";8////"_$P(ACRDATA,U,8)
  1.  S ACRDR=ACRDR_";9////"_$P(ACRDATA,U,9)
  1.  S ACRDR=ACRDR_";10////"_$P(ACRDATA,U,10)
  1.  S ACRDR=ACRDR_";11////"_$P(ACRDATA,U,11)
  1.  S ACRDR=ACRDR_";12////"_$P(ACRDATA,U,12)
  1.  S ACRDR=ACRDR_";13////"_$P(ACRDATA,U,13)
  1.  S ACRDR=ACRDR_";14////"_$P(ACRDATA,U,14)
  1.  S ACRDR=ACRDR_";15////"_$P(ACRDATA,U,15)
  1.  S ACRDR=ACRDR_";16////"_$P(ACRDATA,U,16)
  1.  S ACRDR=ACRDR_";17////"_$P(ACRDATA,U,17)
  1.  S ACRDR=ACRDR_";18////"_$$PAD^ACRFUTL($P(ACRDATA,U,18),"L",10,"")
  1.  S ACRDR=ACRDR_";19////"_$E($P(ACRDATA,U,19),1,2)
  1.  S ACRDR=ACRDR_";20////"_$P(ACRDATA,U,20)
  1.  S ACRDR=ACRDR_";21////"_$P(ACRDATA,U,21)
  1.  S ACRDR=ACRDR_";22////"_$P(ACRDATA,U,22)
  1.  S ACRDR=ACRDR_";23////"_$P(ACRDATA,U,23)
  1.  S ACRDR=ACRDR_";24////"_$P(ACRDATA,U,24)
  1.  S ACRDR=ACRDR_";25////"_$P(ACRDATA,U,25)
  1.  S ACRDR=ACRDR_";26////"_$P(ACRDATA,U,26)
  1.  S ACRDR=ACRDR_";27////"_$P(ACRDATA,U,27)
  1.  S ACRDR=ACRDR_";28////"_$P(ACRDATA,U,28)
  1.  S ACRDR=ACRDR_";99////"_ACRIEN
  1.  ;
  1.  D DHRRCD^ACRFDHR1
  1.  Q
  1. CHK() ;----- CHECKS TO SEE IF RECORDS EXISTIN ARMS-BLUE OR ARMS-RED
  1.  ;
  1.  ;      RETURNS:
  1.  ;      0 IF NO RECORDS ARE FOUND
  1.  ;      1 IF RECORDS ARE FOUND
  1.  ;
  1.  N D0,D1,D2
  1.  S Y=0
  1.  F D0=5,6 D
  1.  . S D1=0
  1.  . F  S D1=$O(^AFSHRCDS(D0,"D",D1)) Q:'D1  D
  1.  . . S D2=0
  1.  . . F  S D2=$O(^AFSHRCDS(D0,"D",D1,"I",D2)) Q:'D2  D
  1.  . . . I $O(^AFSHRCDS(D0,"D",D1,"I",D2,"S",0)) S Y=1
  1.  Q Y
  1. TXT ;----- WRITE TEXT
  1.  ;
  1.  N I,X
  1.  F I=1:1 S X=$T(TXT1+I) Q:X["$$END"  W !?5,$P(X,";",3)
  1.  Q
  1. TXT1 ;;
  1.  ;;
  1.  ;;This option will loop through the DHR history file and find the
  1.  ;;transactions for the specified date or IEN range which
  1.  ;;have not been transmitted to CORE.  These transactions will be
  1.  ;;placed into an ARMS batch for transmission.  It is recommended
  1.  ;;that all records be cleared from the ARMS-BLUE and ARMS-RED
  1.  ;;batches before running this option.
  1.  ;;
  1.  ;;$$END