ACRFSPL1 ;IHS/OIRM/DSD/AEF - DHR-SPLITOUT [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;
;This routine produces a display of batches available for export and
;prompts the user for which batch to export. The variable ACRD0 is
;returned set to the internal number of the batch to be exported.
;
;
EN(ACRCTR,ACRDTNM,ACRPKG) ;EP
;----- MAIN ENTRY POINT
;
; ACRCTR = TYPE OF TRANSACTIONS
; ARM = ARMS
; BCS = CHS
; PCC = MANUALLY ENTERED
; ACRDTNM = DATA TYPE NAME
; DHRP
; dhc
; ACRPKG = PACKAGE
; AFSH = ARMS
; ACHS = CHS
;
N ACR,ACRDISP,ACRNTRB,ACRNTRL,ACROUT,ACRZ
D ^XBKVAR
D HOME^%ZIS
D HDR
D GET
D HDR1
D HDR2
D HDR3
D SHOW
D PROMPT
I $G(ACROUT) K ACRD0 Q
Q
GET ;----- GETS DATA TO DISPLAY
;
; ACRD0 = BATCH COLOR
; 1 = PCC-BLUE
; 2 = PCC-RED
; 3 = CHS-BLUE
; 4 = CHS-RED
; 5 = ARMS-BLUE
; 6 = ARMS-RED
;
N ACRD0
K ACR
I ACRCTR="PCC" F ACRD0=1,2 D LOOP(ACRD0)
I ACRCTR="BCS" F ACRD0=3,4 D LOOP(ACRD0)
I ACRCTR="ARM" F ACRD0=5,6 D LOOP(ACRD0)
D DISP
Q
LOOP(ACRD0) ;
;----- LOOPS THROUGH THE BATCH COLOR ENTRIES TO GATHER DATA FOR DISPLAY
;
; DATA = REUSABLE DATA VARIABLE
; ACR = ARRAY CONTAINING BATCH DATA:
; ACR(COLORIEN,BATCHDATE)=1ST BATCHID^LAST BATCHID^NUMBER
; OF BATCHES^NUMBER OF RECORDS^NUMBER OF NO TRAILERS
;
N ACRD1,ACRD2,ACRD3,DATA
S ACRD1=0
F S ACRD1=$O(^AFSHRCDS(ACRD0,"D",ACRD1)) Q:'ACRD1 D
. S ACR(ACRD0,ACRD1)=""
. S DATA=$P(^AFSHRCDS(ACRD0,0),U,2) ;color export date
. S ACR(ACRD0,"STATUS")=$S(DATA="":"E",1:"T")_U_DATA
. S ACRD2=0
. F S ACRD2=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2)) Q:'ACRD2 D
. . S DATA=^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0)
. . I $P(ACR(ACRD0,ACRD1),U)="" S $P(ACR(ACRD0,ACRD1),U)=$P(DATA,U)
. . S $P(ACR(ACRD0,ACRD1),U,2)=$P(DATA,U)
. . S $P(ACR(ACRD0,ACRD1),U,3)=$P(ACR(ACRD0,ACRD1),U,3)+1
. . I $P(DATA,U,3)'="C" D
. . . S $P(ACR(ACRD0,ACRD1),U,5)=$P(ACR(ACRD0,ACRD1),U,5)+1
. . . S ACRNTRL(ACRD0)=1
. . . S ACRNTRB(ACRD0,ACRD1,$P(DATA,U))=""
. . S ACRD3=0
. . F S ACRD3=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3)) Q:'ACRD3 D
. . . S $P(ACR(ACRD0,ACRD1),U,4)=$P(ACR(ACRD0,ACRD1),U,4)+1
Q
DISP ;----- BUILDS DISPLAY ARRAY
;
N ACRD0,ACRD1,CNT
S (ACRZ(1),ACRZ(2),ACRD0)=0
F S ACRD0=$O(ACR(ACRD0)) Q:'ACRD0 D
. S (ACRD1,CNT)=0
. F S ACRD1=$O(ACR(ACRD0,ACRD1)) Q:'ACRD1 D
. . S CNT=CNT+1
. . S $P(ACRDISP(CNT),";",$S(ACRD0#2:1,1:2))=ACRD1_U_ACR(ACRD0,ACRD1)
. . S ACRZ($S(ACRD0#2:1,1:2))=1
Q
SHOW ;----- SHOW BATCHES
;
N DATA,I,PC
S I=0
F S I=$O(ACRDISP(I)) Q:'I D
. W !
. F PC=1,2 D
. . S DATA=$P(ACRDISP(I),";",PC)
. . W ?$S(PC=1:5,1:41)
. . W $$DATE($P(DATA,U))
. . W " "
. . W $J($P(DATA,U,4),3)
. . W " "
. . W $P(DATA,U,2)_$S($P(DATA,U,2)]"":"-",1:"")_$P(DATA,U,3)
. . W " "
. . W $J($P(DATA,U,5),4)
. . W " "
. . W $J($P(DATA,U,6),3)
. . I PC=1 W " |"
Q
DATE(X) ;----- RETURNS DATE IN MM/DD/YY FORMAT
;
I X]"" S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
Q X
;
PROMPT ;----- PROMPTS USER FOR WHICH BATCH TO EXPORT
;
N DIR,X,Y
S DIR(0)="SBM^B:BLUE;R:RED"
S DIR("A")="Enter Batch COLOR to USE"
W !
D ^DIR
I $D(DIRUT) S ACROUT=1 Q
I Y="B" S ACRD0=$S(ACRCTR="PCC":1,ACRCTR="BCS":3,ACRCTR="ARM":5,1:"")
I Y="R" S ACRD0=$S(ACRCTR="PCC":2,ACRCTR="BCS":4,ACRCTR="ARM":6,1:"")
I '$G(ACRD0) S ACROUT=1 Q
I '$D(ACR(ACRD0)) W !?10,*7,"Batch COLOR NOT AVAILABLE FOR EXPORT -- Select AGAIN" G PROMPT
I $D(ACRNTRL(ACRD0)) D
. D NTRL
. W !!,*7,"All Batches MUST have a trailer -- JOB CANCELLED"
. S ACROUT=1
Q
NTRL ;----- LISTS BATCHES WITH NO TRAILERS
;
N ACRD0,ACRD1,ACRI,DIR,X,Y
S DIR(0)="Y"
S DIR("A")="Batches exist w/o TRAILERS -- want to see a list"
S DIR("B")="YES"
D ^DIR
Q:'Y
S ACRD0=0
F S ACRD0=$O(ACRNTRB(ACRD0)) Q:'ACRD0 D
. S ACRD1=0
. F S ACRD1=$O(ACRNTRB(ACRD0,ACRD1)) Q:'ACRD1 D
. . S ACRI=""
. . F S ACRI=$O(ACRNTRB(ACRD0,ACRD1,ACRI)) Q:ACRI']"" D
. . . W !?5,$$DATE(ACRD1)_"-"_ACRI
Q
HDR ;----- WRITES MAIN OPTION HEADER
;
D ^XBCLS
N I
S ACRPKG=$S(ACRCTR="PCC"!(ACRCTR="ARM"):"REGULAR FINANCE TRANSACTIONS",ACRCTR="BCS":"CHS CORRECTIONS TRANSACTIONS",1:"")
W !?18
F I=1:1:45 W "*"
W !?18,"*"
W ?22,"IHS AREA OFFICE DHR EXPORT (SPLITOUT)"
W ?62,"*"
W !?18,"*"
W ?26,ACRPKG
W ?62,"*"
W !?18,"*"
W ?34,"VERSION "
W $P($T(ACRFSPL1+1),";",3)
W ?62,"*"
W !?18
F I=1:1:45 W "*"
Q
HDR1 ;----- WRITES HEADER 1
;
N I
W !?5
F I=1:1:70 W "-"
W !?5,"*"
W ?15,"COLOR = BLUE"
W ?40,"*"
W ?56,"COLOR = RED"
W ?74,"*"
W !?5
F I=1:1:70 W "-"
Q
HDR2 ;----- WRITES HEADER 2
;
W !?5,"*"
W ?10,$S($G(ACRZ(1)):"COLOR AVAILABLE FOR EXPORT",1:" NO DATA ON FILE")
W ?40,"*"
W ?45,$S($G(ACRZ(2)):"COLOR AVAILABLE FOR EXPORT",1:" NO DATA ON FILE")
W ?74,"*"
W !?5
F I=1:1:70 W "-"
Q
HDR3 ;----- WRITES HEADER 3
;
W !,?6,"B. DATE #BCH ID'S RCDS NO-TR"
W ?40,"|"
W ?42,"B. DATE #BCH ID'S RCDS NO-TR"
W !?5
F I=1:1:70 W "-"
Q
ACRFSPL1 ;IHS/OIRM/DSD/AEF - DHR-SPLITOUT [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;
+3 ;This routine produces a display of batches available for export and
+4 ;prompts the user for which batch to export. The variable ACRD0 is
+5 ;returned set to the internal number of the batch to be exported.
+6 ;
+7 ;
EN(ACRCTR,ACRDTNM,ACRPKG) ;EP
+1 ;----- MAIN ENTRY POINT
+2 ;
+3 ; ACRCTR = TYPE OF TRANSACTIONS
+4 ; ARM = ARMS
+5 ; BCS = CHS
+6 ; PCC = MANUALLY ENTERED
+7 ; ACRDTNM = DATA TYPE NAME
+8 ; DHRP
+9 ; dhc
+10 ; ACRPKG = PACKAGE
+11 ; AFSH = ARMS
+12 ; ACHS = CHS
+13 ;
+14 NEW ACR,ACRDISP,ACRNTRB,ACRNTRL,ACROUT,ACRZ
+15 DO ^XBKVAR
+16 DO HOME^%ZIS
+17 DO HDR
+18 DO GET
+19 DO HDR1
+20 DO HDR2
+21 DO HDR3
+22 DO SHOW
+23 DO PROMPT
+24 IF $GET(ACROUT)
KILL ACRD0
QUIT
+25 QUIT
GET ;----- GETS DATA TO DISPLAY
+1 ;
+2 ; ACRD0 = BATCH COLOR
+3 ; 1 = PCC-BLUE
+4 ; 2 = PCC-RED
+5 ; 3 = CHS-BLUE
+6 ; 4 = CHS-RED
+7 ; 5 = ARMS-BLUE
+8 ; 6 = ARMS-RED
+9 ;
+10 NEW ACRD0
+11 KILL ACR
+12 IF ACRCTR="PCC"
FOR ACRD0=1,2
DO LOOP(ACRD0)
+13 IF ACRCTR="BCS"
FOR ACRD0=3,4
DO LOOP(ACRD0)
+14 IF ACRCTR="ARM"
FOR ACRD0=5,6
DO LOOP(ACRD0)
+15 DO DISP
+16 QUIT
LOOP(ACRD0) ;
+1 ;----- LOOPS THROUGH THE BATCH COLOR ENTRIES TO GATHER DATA FOR DISPLAY
+2 ;
+3 ; DATA = REUSABLE DATA VARIABLE
+4 ; ACR = ARRAY CONTAINING BATCH DATA:
+5 ; ACR(COLORIEN,BATCHDATE)=1ST BATCHID^LAST BATCHID^NUMBER
+6 ; OF BATCHES^NUMBER OF RECORDS^NUMBER OF NO TRAILERS
+7 ;
+8 NEW ACRD1,ACRD2,ACRD3,DATA
+9 SET ACRD1=0
+10 FOR
SET ACRD1=$ORDER(^AFSHRCDS(ACRD0,"D",ACRD1))
IF 'ACRD1
QUIT
Begin DoDot:1
+11 SET ACR(ACRD0,ACRD1)=""
+12 ;color export date
SET DATA=$PIECE(^AFSHRCDS(ACRD0,0),U,2)
+13 SET ACR(ACRD0,"STATUS")=$SELECT(DATA="":"E",1:"T")_U_DATA
+14 SET ACRD2=0
+15 FOR
SET ACRD2=$ORDER(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2))
IF 'ACRD2
QUIT
Begin DoDot:2
+16 SET DATA=^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0)
+17 IF $PIECE(ACR(ACRD0,ACRD1),U)=""
SET $PIECE(ACR(ACRD0,ACRD1),U)=$PIECE(DATA,U)
+18 SET $PIECE(ACR(ACRD0,ACRD1),U,2)=$PIECE(DATA,U)
+19 SET $PIECE(ACR(ACRD0,ACRD1),U,3)=$PIECE(ACR(ACRD0,ACRD1),U,3)+1
+20 IF $PIECE(DATA,U,3)'="C"
Begin DoDot:3
+21 SET $PIECE(ACR(ACRD0,ACRD1),U,5)=$PIECE(ACR(ACRD0,ACRD1),U,5)+1
+22 SET ACRNTRL(ACRD0)=1
+23 SET ACRNTRB(ACRD0,ACRD1,$PIECE(DATA,U))=""
End DoDot:3
+24 SET ACRD3=0
+25 FOR
SET ACRD3=$ORDER(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3))
IF 'ACRD3
QUIT
Begin DoDot:3
+26 SET $PIECE(ACR(ACRD0,ACRD1),U,4)=$PIECE(ACR(ACRD0,ACRD1),U,4)+1
End DoDot:3
End DoDot:2
End DoDot:1
+27 QUIT
DISP ;----- BUILDS DISPLAY ARRAY
+1 ;
+2 NEW ACRD0,ACRD1,CNT
+3 SET (ACRZ(1),ACRZ(2),ACRD0)=0
+4 FOR
SET ACRD0=$ORDER(ACR(ACRD0))
IF 'ACRD0
QUIT
Begin DoDot:1
+5 SET (ACRD1,CNT)=0
+6 FOR
SET ACRD1=$ORDER(ACR(ACRD0,ACRD1))
IF 'ACRD1
QUIT
Begin DoDot:2
+7 SET CNT=CNT+1
+8 SET $PIECE(ACRDISP(CNT),";",$SELECT(ACRD0#2:1,1:2))=ACRD1_U_ACR(ACRD0,ACRD1)
+9 SET ACRZ($SELECT(ACRD0#2:1,1:2))=1
End DoDot:2
End DoDot:1
+10 QUIT
SHOW ;----- SHOW BATCHES
+1 ;
+2 NEW DATA,I,PC
+3 SET I=0
+4 FOR
SET I=$ORDER(ACRDISP(I))
IF 'I
QUIT
Begin DoDot:1
+5 WRITE !
+6 FOR PC=1,2
Begin DoDot:2
+7 SET DATA=$PIECE(ACRDISP(I),";",PC)
+8 WRITE ?$SELECT(PC=1:5,1:41)
+9 WRITE $$DATE($PIECE(DATA,U))
+10 WRITE " "
+11 WRITE $JUSTIFY($PIECE(DATA,U,4),3)
+12 WRITE " "
+13 WRITE $PIECE(DATA,U,2)_$SELECT($PIECE(DATA,U,2)]"":"-",1:"")_$PIECE(DATA,U,3)
+14 WRITE " "
+15 WRITE $JUSTIFY($PIECE(DATA,U,5),4)
+16 WRITE " "
+17 WRITE $JUSTIFY($PIECE(DATA,U,6),3)
+18 IF PC=1
WRITE " |"
End DoDot:2
End DoDot:1
+19 QUIT
DATE(X) ;----- RETURNS DATE IN MM/DD/YY FORMAT
+1 ;
+2 IF X]""
SET X=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+3 QUIT X
+4 ;
PROMPT ;----- PROMPTS USER FOR WHICH BATCH TO EXPORT
+1 ;
+2 NEW DIR,X,Y
+3 SET DIR(0)="SBM^B:BLUE;R:RED"
+4 SET DIR("A")="Enter Batch COLOR to USE"
+5 WRITE !
+6 DO ^DIR
+7 IF $DATA(DIRUT)
SET ACROUT=1
QUIT
+8 IF Y="B"
SET ACRD0=$SELECT(ACRCTR="PCC":1,ACRCTR="BCS":3,ACRCTR="ARM":5,1:"")
+9 IF Y="R"
SET ACRD0=$SELECT(ACRCTR="PCC":2,ACRCTR="BCS":4,ACRCTR="ARM":6,1:"")
+10 IF '$GET(ACRD0)
SET ACROUT=1
QUIT
+11 IF '$DATA(ACR(ACRD0))
WRITE !?10,*7,"Batch COLOR NOT AVAILABLE FOR EXPORT -- Select AGAIN"
GOTO PROMPT
+12 IF $DATA(ACRNTRL(ACRD0))
Begin DoDot:1
+13 DO NTRL
+14 WRITE !!,*7,"All Batches MUST have a trailer -- JOB CANCELLED"
+15 SET ACROUT=1
End DoDot:1
+16 QUIT
NTRL ;----- LISTS BATCHES WITH NO TRAILERS
+1 ;
+2 NEW ACRD0,ACRD1,ACRI,DIR,X,Y
+3 SET DIR(0)="Y"
+4 SET DIR("A")="Batches exist w/o TRAILERS -- want to see a list"
+5 SET DIR("B")="YES"
+6 DO ^DIR
+7 IF 'Y
QUIT
+8 SET ACRD0=0
+9 FOR
SET ACRD0=$ORDER(ACRNTRB(ACRD0))
IF 'ACRD0
QUIT
Begin DoDot:1
+10 SET ACRD1=0
+11 FOR
SET ACRD1=$ORDER(ACRNTRB(ACRD0,ACRD1))
IF 'ACRD1
QUIT
Begin DoDot:2
+12 SET ACRI=""
+13 FOR
SET ACRI=$ORDER(ACRNTRB(ACRD0,ACRD1,ACRI))
IF ACRI']""
QUIT
Begin DoDot:3
+14 WRITE !?5,$$DATE(ACRD1)_"-"_ACRI
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
HDR ;----- WRITES MAIN OPTION HEADER
+1 ;
+2 DO ^XBCLS
+3 NEW I
+4 SET ACRPKG=$SELECT(ACRCTR="PCC"!(ACRCTR="ARM"):"REGULAR FINANCE TRANSACTIONS",ACRCTR="BCS":"CHS CORRECTIONS TRANSACTIONS",1:"")
+5 WRITE !?18
+6 FOR I=1:1:45
WRITE "*"
+7 WRITE !?18,"*"
+8 WRITE ?22,"IHS AREA OFFICE DHR EXPORT (SPLITOUT)"
+9 WRITE ?62,"*"
+10 WRITE !?18,"*"
+11 WRITE ?26,ACRPKG
+12 WRITE ?62,"*"
+13 WRITE !?18,"*"
+14 WRITE ?34,"VERSION "
+15 WRITE $PIECE($TEXT(ACRFSPL1+1),";",3)
+16 WRITE ?62,"*"
+17 WRITE !?18
+18 FOR I=1:1:45
WRITE "*"
+19 QUIT
HDR1 ;----- WRITES HEADER 1
+1 ;
+2 NEW I
+3 WRITE !?5
+4 FOR I=1:1:70
WRITE "-"
+5 WRITE !?5,"*"
+6 WRITE ?15,"COLOR = BLUE"
+7 WRITE ?40,"*"
+8 WRITE ?56,"COLOR = RED"
+9 WRITE ?74,"*"
+10 WRITE !?5
+11 FOR I=1:1:70
WRITE "-"
+12 QUIT
HDR2 ;----- WRITES HEADER 2
+1 ;
+2 WRITE !?5,"*"
+3 WRITE ?10,$SELECT($GET(ACRZ(1)):"COLOR AVAILABLE FOR EXPORT",1:" NO DATA ON FILE")
+4 WRITE ?40,"*"
+5 WRITE ?45,$SELECT($GET(ACRZ(2)):"COLOR AVAILABLE FOR EXPORT",1:" NO DATA ON FILE")
+6 WRITE ?74,"*"
+7 WRITE !?5
+8 FOR I=1:1:70
WRITE "-"
+9 QUIT
HDR3 ;----- WRITES HEADER 3
+1 ;
+2 WRITE !,?6,"B. DATE #BCH ID'S RCDS NO-TR"
+3 WRITE ?40,"|"
+4 WRITE ?42,"B. DATE #BCH ID'S RCDS NO-TR"
+5 WRITE !?5
+6 FOR I=1:1:70
WRITE "-"
+7 QUIT
