ACRFSPL3 ;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
;----- MAIN ENTRY POINT
;
; REQUIRES ACRD0 = IEN OF DHR DATA RECORDS FILE
;
N X,Y,ACRJOB,ZTDESC,ZTRTN,ZTSAVE
D ^XBKVAR,HOME^%ZIS
S ACRJOB=$J
S ZTSAVE("ACRJOB")=""
S ZTSAVE("ACRD0")=""
D QUE^ACRFUTL("DQ^ACRFSPL3",.ZTSAVE,"BATCH SPLIT-OUT REPORT") ;ACR*2.1*13.06 IM14144
D ^%ZISC
Q
DQ ;----- QUEUED JOB STARTS HERE
;
D PRT
;K ^TMP("ACRDHR",ACRJOB)
D ^%ZISC
Q
PRT ;----- PRINT REPORT
;
N ACRD1,ACRD2,ACRD2X,ACRD3,ACROUT,CNT,BATCH,BATCHID,BATCHIDX,DIR,PAGE,X,Y
S BATCH=$S(ACRD0=1:"PCC-BLUE",ACRD0=2:"PCC-RED",ACRD0=3:"CHS-BLUE",ACRD0=4:"CHS-RED",ACRD0=5:"ARM-BLUE",ACRD0=6:"ARM-RED",1:"")
I '$D(^TMP("ACRDHR",ACRJOB)) D HDR W !!,"No records to print" Q
S ACRD1=0,BATCHIDX=""
F S ACRD1=$O(^TMP("ACRDHR",ACRJOB,ACRD0,ACRD1)) Q:'ACRD1 D Q:$G(ACROUT)
. S ACRD2=""
. F S ACRD2=$O(^TMP("ACRDHR",ACRJOB,ACRD0,ACRD1,ACRD2)) Q:ACRD2']"" D Q:$G(ACROUT)
. . S BATCHID=ACRD1_"-"_ACRD2
. . I BATCHIDX'="",BATCHID'=BATCHIDX D
. . . W !!,"BATCH: ",BATCHIDX
. . . S DATA=^TMP("ACRDHR",ACRJOB,ACRD0,$P(BATCHIDX,"-"),$P(BATCHIDX,"-",2),0)
. . . W ?20,"BATCH RECORD COUNT: ",$J($P(DATA,U),4)
. . . W ?46,"BATCH AMOUNT: ",$J($P(DATA,U,2),12,2)
. . S BATCHIDX=BATCHID
. . S (ACRD3,CNT)=0
. . F S ACRD3=$O(^TMP("ACRDHR",ACRJOB,ACRD0,ACRD1,ACRD2,ACRD3)) Q:'ACRD3 D Q:$G(ACROUT)
. . . I 'CNT D HDR W !,"BATCH: ",ACRD1,"-",ACRD2
. . . I $E(IOST)="C",CNT>1 D HDR S CNT=0
. . . I $E(IOST)'="C",CNT>5 D HDR S CNT=0
. . . S CNT=CNT+1
. . . W !
. . . F I=1:1:5 W ^TMP("ACRDHR",ACRJOB,ACRD0,ACRD1,ACRD2,ACRD3,I)
S DATA=^TMP("ACRDHR",ACRJOB,ACRD0,$P(BATCHIDX,"-"),$P(BATCHIDX,"-",2),0)
W !!,"BATCH: ",BATCHIDX
W ?20,"BATCH RECORD COUNT: ",$J($P(DATA,U),4)
W ?46,"BATCH AMOUNT: ",$J($P(DATA,U,2),12,2)
S DATA=^TMP("ACRDHR",ACRJOB,ACRD0,0)
W !!?20,"TOTAL RECORD COUNT: ",$J($P(DATA,U),4)
W ?46,"TOTAL AMOUNT: ",$J($P(DATA,U,2),12,2)
I $E(IOST)="C" S DIR(0)="E" D ^DIR K DIR
Q
HDR ;----- WRITE REPORT HEADER
;
N DIR
I $E(IOST)="C",$G(PAGE) S DIR(0)="E" D ^DIR K DIR I 'Y S ACROUT=1 Q
S PAGE=$G(PAGE)+1
W @IOF
W !,"D H R S P L I T - O U T P R O G R A M"
W ?62,$$NOW
W !,$G(BATCH)," Listing of Individual Records"
W ?62,"PAGE ",$J(PAGE,3)
W !!,?9,1,?19,2,?29,3,?39,4,?49,5,?59,6,?69,7,?79,8
W !
F I=1:1:8 W "1234567890"
W !
Q
NOW() ;----- RETURNS CURRENT DATE/TIME
;
N %,%H,%I,X
D NOW^%DTC
S Y=DT
X ^DD("DD")
Q Y_" "_$E($P(%,".",2),1,2)_":"_$E($P(%,".",2),3,4)
ACRFSPL3 ;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
+1 ;----- MAIN ENTRY POINT
+2 ;
+3 ; REQUIRES ACRD0 = IEN OF DHR DATA RECORDS FILE
+4 ;
+5 NEW X,Y,ACRJOB,ZTDESC,ZTRTN,ZTSAVE
+6 DO ^XBKVAR
DO HOME^%ZIS
+7 SET ACRJOB=$JOB
+8 SET ZTSAVE("ACRJOB")=""
+9 SET ZTSAVE("ACRD0")=""
+10 ;ACR*2.1*13.06 IM14144
DO QUE^ACRFUTL("DQ^ACRFSPL3",.ZTSAVE,"BATCH SPLIT-OUT REPORT")
+11 DO ^%ZISC
+12 QUIT
DQ ;----- QUEUED JOB STARTS HERE
+1 ;
+2 DO PRT
+3 ;K ^TMP("ACRDHR",ACRJOB)
+4 DO ^%ZISC
+5 QUIT
PRT ;----- PRINT REPORT
+1 ;
+2 NEW ACRD1,ACRD2,ACRD2X,ACRD3,ACROUT,CNT,BATCH,BATCHID,BATCHIDX,DIR,PAGE,X,Y
+3 SET BATCH=$SELECT(ACRD0=1:"PCC-BLUE",ACRD0=2:"PCC-RED",ACRD0=3:"CHS-BLUE",ACRD0=4:"CHS-RED",ACRD0=5:"ARM-BLUE",ACRD0=6:"ARM-RED",1:"")
+4 IF '$DATA(^TMP("ACRDHR",ACRJOB))
DO HDR
WRITE !!,"No records to print"
QUIT
+5 SET ACRD1=0
SET BATCHIDX=""
+6 FOR
SET ACRD1=$ORDER(^TMP("ACRDHR",ACRJOB,ACRD0,ACRD1))
IF 'ACRD1
QUIT
Begin DoDot:1
+7 SET ACRD2=""
+8 FOR
SET ACRD2=$ORDER(^TMP("ACRDHR",ACRJOB,ACRD0,ACRD1,ACRD2))
IF ACRD2']""
QUIT
Begin DoDot:2
+9 SET BATCHID=ACRD1_"-"_ACRD2
+10 IF BATCHIDX'=""
IF BATCHID'=BATCHIDX
Begin DoDot:3
+11 WRITE !!,"BATCH: ",BATCHIDX
+12 SET DATA=^TMP("ACRDHR",ACRJOB,ACRD0,$PIECE(BATCHIDX,"-"),$PIECE(BATCHIDX,"-",2),0)
+13 WRITE ?20,"BATCH RECORD COUNT: ",$JUSTIFY($PIECE(DATA,U),4)
+14 WRITE ?46,"BATCH AMOUNT: ",$JUSTIFY($PIECE(DATA,U,2),12,2)
End DoDot:3
+15 SET BATCHIDX=BATCHID
+16 SET (ACRD3,CNT)=0
+17 FOR
SET ACRD3=$ORDER(^TMP("ACRDHR",ACRJOB,ACRD0,ACRD1,ACRD2,ACRD3))
IF 'ACRD3
QUIT
Begin DoDot:3
+18 IF 'CNT
DO HDR
WRITE !,"BATCH: ",ACRD1,"-",ACRD2
+19 IF $EXTRACT(IOST)="C"
IF CNT>1
DO HDR
SET CNT=0
+20 IF $EXTRACT(IOST)'="C"
IF CNT>5
DO HDR
SET CNT=0
+21 SET CNT=CNT+1
+22 WRITE !
+23 FOR I=1:1:5
WRITE ^TMP("ACRDHR",ACRJOB,ACRD0,ACRD1,ACRD2,ACRD3,I)
End DoDot:3
IF $GET(ACROUT)
QUIT
End DoDot:2
IF $GET(ACROUT)
QUIT
End DoDot:1
IF $GET(ACROUT)
QUIT
+24 SET DATA=^TMP("ACRDHR",ACRJOB,ACRD0,$PIECE(BATCHIDX,"-"),$PIECE(BATCHIDX,"-",2),0)
+25 WRITE !!,"BATCH: ",BATCHIDX
+26 WRITE ?20,"BATCH RECORD COUNT: ",$JUSTIFY($PIECE(DATA,U),4)
+27 WRITE ?46,"BATCH AMOUNT: ",$JUSTIFY($PIECE(DATA,U,2),12,2)
+28 SET DATA=^TMP("ACRDHR",ACRJOB,ACRD0,0)
+29 WRITE !!?20,"TOTAL RECORD COUNT: ",$JUSTIFY($PIECE(DATA,U),4)
+30 WRITE ?46,"TOTAL AMOUNT: ",$JUSTIFY($PIECE(DATA,U,2),12,2)
+31 IF $EXTRACT(IOST)="C"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+32 QUIT
HDR ;----- WRITE REPORT HEADER
+1 ;
+2 NEW DIR
+3 IF $EXTRACT(IOST)="C"
IF $GET(PAGE)
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET ACROUT=1
QUIT
+4 SET PAGE=$GET(PAGE)+1
+5 WRITE @IOF
+6 WRITE !,"D H R S P L I T - O U T P R O G R A M"
+7 WRITE ?62,$$NOW
+8 WRITE !,$GET(BATCH)," Listing of Individual Records"
+9 WRITE ?62,"PAGE ",$JUSTIFY(PAGE,3)
+10 WRITE !!,?9,1,?19,2,?29,3,?39,4,?49,5,?59,6,?69,7,?79,8
+11 WRITE !
+12 FOR I=1:1:8
WRITE "1234567890"
+13 WRITE !
+14 QUIT
NOW() ;----- RETURNS CURRENT DATE/TIME
+1 ;
+2 NEW %,%H,%I,X
+3 DO NOW^%DTC
+4 SET Y=DT
+5 XECUTE ^DD("DD")
+6 QUIT Y_" "_$EXTRACT($PIECE(%,".",2),1,2)_":"_$EXTRACT($PIECE(%,".",2),3,4)
