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