ACRFSPL2.m

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