ACRFSPL2 ;IHS/OIRM/DSD/AEF - DHR-SPLITOUT [ 10/27/2004 4:18 PM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001
;
EN(ACRD0) ;EP ; ACR*2.1*13.01 IM13574
;----- MAIN ENTRY POINT
;
; ACRD0 = COLOR BATCH IEN FROM DHR DATA RECORDS FILE TO BE
; EXPORTED
; ACRCTR = WHAT KIND OF EXPORT, I.E., ARM, BCS, PCC
;
N %DEV,ACROUT
D HFS(.%DEV) ;ACR*2.1*13.01 IM13574
Q:$G(ACROUT)
D CLOSE(ACRD0) ;ACR*2.1*13.01 IM13574
Q:$G(ACROUT)
D DATA(ACRD0) ;ACR*2.1*13.01 IM13574
Q:'$D(^TMP("ACRDHR-EXP",$J))
D EXP(%DEV) ;ACR*2.1*13.01 IM13574
D CLOSE^ACRFZISH("FILE") ;ACR*2.1*13.01 IM13574
Q
CLOSE(ACRD0) ;----- SET EXPORT DATE
;
N DA,DIE,DR,X,Y
L +^AFSHRCDS(ACRD0):1
I '$T W !,*7,"Users are active in this batch - TRY LATER" S ACROUT=1
I $P(^AFSHRCDS(ACRD0,0),U,2) W !,*7,"This batch has already been exported" S ACROUT=1
I '$G(ACROUT) D
.S DIE="^AFSHRCDS("
.S DA=ACRD0
.D NOW^%DTC
.S DR=".21///^S X=%"
.D ^DIE
L -^AFSHRCDS(ACRD0)
Q
EXP(%DEV) ;----- EXPORT DHR DATA TO UNIX FILE ; ACR*2.1*13.01 IM13574
;
N X1,X2
S X1=0
F S X1=$O(^TMP("ACRDHR-EXP",$J,X1)) Q:'X1 D
. F X2=1:1:5 D
. . U %DEV
. . W ^TMP("ACRDHR-EXP",$J,X1,X2)
Q
DATA(ACRD0) ;----- GATHER DHR DATA AND PUT INTO ^TMP GLOBAL ; ACR*2.1*13.01 IM13574
;
;N ACRAMT,ACRCNT,ACRD1,ACRD2,ACRD3,AMT,CNT,DATA,X,Y,Z
K ^TMP("ACRDHR",$J)
S (ACRD1,ACRCNT)=0
F S ACRD1=$O(^AFSHRCDS(ACRD0,"D",ACRD1)) Q:'ACRD1 D
. 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)
. . S (ACRD3,AMT,CNT)=0
. . F S ACRD3=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3)) Q:'ACRD3 D
. . . S ACRCNT=ACRCNT+1
. . . S CNT=CNT+1
. . . S X=^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3,0)
. . . S Y=ACRD0_U_ACRD1_U_$P(DATA,U)_U_ACRD3_U_$P(DATA,U,7)_U_ACRCNT
. . . I $P(Y,U,5)="" S $P(Y,U,5)=$G(DUZ)
. . . S AMT=$P(X,U,15)
. . . I $P(X,U,5)=2 S AMT=0-AMT
. . . S $P(^TMP("ACRDHR",$J,ACRD0,0),U)=ACRCNT
. . . S $P(^TMP("ACRDHR",$J,ACRD0,0),U,2)=$P(^TMP("ACRDHR",$J,ACRD0,0),U,2)+AMT
. . . S $P(^TMP("ACRDHR",$J,ACRD0,ACRD1,$P(DATA,U),0),U)=CNT
. . . S $P(^TMP("ACRDHR",$J,ACRD0,ACRD1,$P(DATA,U),0),U,2)=$P(^TMP("ACRDHR",$J,ACRD0,ACRD1,$P(DATA,U),0),U,2)+AMT
. . . D DATA^ACRFSPL6(X,Y)
Q
HFS(%DEV) ;----- CREATE/OPEN UNIX FILE ; ACR*2.1*13.06 IM14144
N ACRFILE,X,Y,ZISH1 ; ACR*2.1*13.06 IM14144
D FILE(.ACRFILE) ; ACR*2.1*13.06 IM14144
Q:$G(ACROUT) ; ACR*2.1*13.06 IM14144
S ZISH1=$$ARMSDIR^ACRFSYS(1) ; ACR*2.1*13.06 IM14144
Q:ZISH1']"" ; ACR*2.1*13.06 IM14144
D HFS^ACRFZISH(ZISH1,ACRFILE,"W",.%DEV) ; VERBOSE ; ACR*2.1*13.01 IM13574
I $G(%DEV)']"" S ACROUT=1 ; ACR*2.1*13.01 IM13574
Q
FILE(FILE) ;----- GET FILE NAME
;
N DIC,I,Q,X,Y,Z
L +^ACRF(9002196.3):4
S FILE=""
S Z=$S(ACRD0=1:"afsdhpb",ACRD0=2:"afsdhpr",ACRD0=3:"afsdhcb",ACRD0=4:"afsdhcr",ACRD0=5:"afsdhab",ACRD0=6:"afsdhar",1:"")
I Z="" S ACROUT=1 Q
F I=97:1:122 S Q=$C(I) I '$D(^ACRF(9002196.3,"B",Z_Q_"."_$E(DT,2,3)_$$JDT^XBFUNC(DT))) S FILE=Z_Q_"."_$E(DT,2,3)_$$JDT^XBFUNC(DT) Q
I FILE="" S ACROUT=1 L -^ACRF(9002196.3) Q
K DD,DO
S DIC="^ACRF(9002196.3,"
S DIC(0)=""
S X=FILE
S DIC("DR")=".02///^S X=DT"
D FILE^DICN
I Y'>0 S ACROUT=1
L -^ACRF(9002196.3)
Q
ACRFSPL2 ;IHS/OIRM/DSD/AEF - DHR-SPLITOUT [ 10/27/2004 4:18 PM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**13**;NOV 05, 2001
+2 ;
EN(ACRD0) ;EP ; ACR*2.1*13.01 IM13574
+1 ;----- MAIN ENTRY POINT
+2 ;
+3 ; ACRD0 = COLOR BATCH IEN FROM DHR DATA RECORDS FILE TO BE
+4 ; EXPORTED
+5 ; ACRCTR = WHAT KIND OF EXPORT, I.E., ARM, BCS, PCC
+6 ;
+7 NEW %DEV,ACROUT
+8 ;ACR*2.1*13.01 IM13574
DO HFS(.%DEV)
+9 IF $GET(ACROUT)
QUIT
+10 ;ACR*2.1*13.01 IM13574
DO CLOSE(ACRD0)
+11 IF $GET(ACROUT)
QUIT
+12 ;ACR*2.1*13.01 IM13574
DO DATA(ACRD0)
+13 IF '$DATA(^TMP("ACRDHR-EXP",$JOB))
QUIT
+14 ;ACR*2.1*13.01 IM13574
DO EXP(%DEV)
+15 ;ACR*2.1*13.01 IM13574
DO CLOSE^ACRFZISH("FILE")
+16 QUIT
CLOSE(ACRD0) ;----- SET EXPORT DATE
+1 ;
+2 NEW DA,DIE,DR,X,Y
+3 LOCK +^AFSHRCDS(ACRD0):1
+4 IF '$TEST
WRITE !,*7,"Users are active in this batch - TRY LATER"
SET ACROUT=1
+5 IF $PIECE(^AFSHRCDS(ACRD0,0),U,2)
WRITE !,*7,"This batch has already been exported"
SET ACROUT=1
+6 IF '$GET(ACROUT)
Begin DoDot:1
+7 SET DIE="^AFSHRCDS("
+8 SET DA=ACRD0
+9 DO NOW^%DTC
+10 SET DR=".21///^S X=%"
+11 DO ^DIE
End DoDot:1
+12 LOCK -^AFSHRCDS(ACRD0)
+13 QUIT
EXP(%DEV) ;----- EXPORT DHR DATA TO UNIX FILE ; ACR*2.1*13.01 IM13574
+1 ;
+2 NEW X1,X2
+3 SET X1=0
+4 FOR
SET X1=$ORDER(^TMP("ACRDHR-EXP",$JOB,X1))
IF 'X1
QUIT
Begin DoDot:1
+5 FOR X2=1:1:5
Begin DoDot:2
+6 USE %DEV
+7 WRITE ^TMP("ACRDHR-EXP",$JOB,X1,X2)
End DoDot:2
End DoDot:1
+8 QUIT
DATA(ACRD0) ;----- GATHER DHR DATA AND PUT INTO ^TMP GLOBAL ; ACR*2.1*13.01 IM13574
+1 ;
+2 ;N ACRAMT,ACRCNT,ACRD1,ACRD2,ACRD3,AMT,CNT,DATA,X,Y,Z
+3 KILL ^TMP("ACRDHR",$JOB)
+4 SET (ACRD1,ACRCNT)=0
+5 FOR
SET ACRD1=$ORDER(^AFSHRCDS(ACRD0,"D",ACRD1))
IF 'ACRD1
QUIT
Begin DoDot:1
+6 SET ACRD2=0
+7 FOR
SET ACRD2=$ORDER(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2))
IF 'ACRD2
QUIT
Begin DoDot:2
+8 SET DATA=^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0)
+9 SET (ACRD3,AMT,CNT)=0
+10 FOR
SET ACRD3=$ORDER(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3))
IF 'ACRD3
QUIT
Begin DoDot:3
+11 SET ACRCNT=ACRCNT+1
+12 SET CNT=CNT+1
+13 SET X=^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3,0)
+14 SET Y=ACRD0_U_ACRD1_U_$PIECE(DATA,U)_U_ACRD3_U_$PIECE(DATA,U,7)_U_ACRCNT
+15 IF $PIECE(Y,U,5)=""
SET $PIECE(Y,U,5)=$GET(DUZ)
+16 SET AMT=$PIECE(X,U,15)
+17 IF $PIECE(X,U,5)=2
SET AMT=0-AMT
+18 SET $PIECE(^TMP("ACRDHR",$JOB,ACRD0,0),U)=ACRCNT
+19 SET $PIECE(^TMP("ACRDHR",$JOB,ACRD0,0),U,2)=$PIECE(^TMP("ACRDHR",$JOB,ACRD0,0),U,2)+AMT
+20 SET $PIECE(^TMP("ACRDHR",$JOB,ACRD0,ACRD1,$PIECE(DATA,U),0),U)=CNT
+21 SET $PIECE(^TMP("ACRDHR",$JOB,ACRD0,ACRD1,$PIECE(DATA,U),0),U,2)=$PIECE(^TMP("ACRDHR",$JOB,ACRD0,ACRD1,$PIECE(DATA,U),0),U,2)+AMT
+22 DO DATA^ACRFSPL6(X,Y)
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
HFS(%DEV) ;----- CREATE/OPEN UNIX FILE ; ACR*2.1*13.06 IM14144
+1 ; ACR*2.1*13.06 IM14144
NEW ACRFILE,X,Y,ZISH1
+2 ; ACR*2.1*13.06 IM14144
DO FILE(.ACRFILE)
+3 ; ACR*2.1*13.06 IM14144
IF $GET(ACROUT)
QUIT
+4 ; ACR*2.1*13.06 IM14144
SET ZISH1=$$ARMSDIR^ACRFSYS(1)
+5 ; ACR*2.1*13.06 IM14144
IF ZISH1']""
QUIT
+6 ; VERBOSE ; ACR*2.1*13.01 IM13574
DO HFS^ACRFZISH(ZISH1,ACRFILE,"W",.%DEV)
+7 ; ACR*2.1*13.01 IM13574
IF $GET(%DEV)']""
SET ACROUT=1
+8 QUIT
FILE(FILE) ;----- GET FILE NAME
+1 ;
+2 NEW DIC,I,Q,X,Y,Z
+3 LOCK +^ACRF(9002196.3):4
+4 SET FILE=""
+5 SET Z=$SELECT(ACRD0=1:"afsdhpb",ACRD0=2:"afsdhpr",ACRD0=3:"afsdhcb",ACRD0=4:"afsdhcr",ACRD0=5:"afsdhab",ACRD0=6:"afsdhar",1:"")
+6 IF Z=""
SET ACROUT=1
QUIT
+7 FOR I=97:1:122
SET Q=$CHAR(I)
IF '$DATA(^ACRF(9002196.3,"B",Z_Q_"."_$EXTRACT(DT,2,3)_$$JDT^XBFUNC(DT)))
SET FILE=Z_Q_"."_$EXTRACT(DT,2,3)_$$JDT^XBFUNC(DT)
QUIT
+8 IF FILE=""
SET ACROUT=1
LOCK -^ACRF(9002196.3)
QUIT
+9 KILL DD,DO
+10 SET DIC="^ACRF(9002196.3,"
+11 SET DIC(0)=""
+12 SET X=FILE
+13 SET DIC("DR")=".02///^S X=DT"
+14 DO FILE^DICN
+15 IF Y'>0
SET ACROUT=1
+16 LOCK -^ACRF(9002196.3)
+17 QUIT
