- 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)
