AFSHBPRT.m

AFSHBPRT ; IHS/OIRM/DSD/JDM -DHR BATCH PRINT PROGRAM ;  [ 10/27/2004   4:20 PM ]

 ;;3.0T1;AO FINANCIAL DATA MGMT SYSTEM;**1,13**;FEB 02, 1999

 ;;MODIFIED FOR CACHE' COMPLIANCE ; ACR*2.1*9

 D CRTSETUP^AFSHCRTS

A0 D ^XBCLS

 F I=1:1:70 W "*"

 W !,?10,"Document History Record (DHR) Batch Print Program",!

 F I=1:1:70 W "*"

 W !!

D5 S DY=22,DX=1 X XY X AFSLE W ?10,"Enter Batch COLOR to USE: (B/R) ('^' to EXIT) "

 S DX=60,%L=1,%F="I",%T="A" X XY X AFSAD D ^AFSHDAT1

 I AFSX1="^" G EXIT

 I "BR"'[AFSX1!(AFSX1="") S DX=55 X XY X AFSLE W *7,"  INVALID ENTRY" H 2 G D5

 S AFSLKEN="AFSEND"_$E(AFSHDTYP,1,1)_AFSX1_"("_$J_")",AFSLKENT=AFSLKEN_":1"

 S AFSLKPGT="AFSEND"_$E(AFSHDTYP,1,1)_AFSX1_":1"

 S AFSLKEXT="AFSEXDHR("_""""_$E(AFSHDTYP,1,1)_AFSX1_"""):1"

 I AFSHDTYP="PCC" S AFSHBCLR=$S(AFSX1="B":1,AFSX1="R":2)

 I AFSHDTYP="BCS" S AFSHBCLR=$S(AFSX1="B":3,AFSX1="R":4)

 I AFSHDTYP="ARM" S AFSHBCLR=$S(AFSX1="B":5,AFSX1="R":6) ; TEMP ARMS TEST

D6 I '$D(AFSHBCNT(AFSHBCLR)) G E0

 I $P(AFSHBCNT(AFSHBCLR,"STATUS"),"^",1)'="T" G E0

 S DY=23,DX=1 X XY X AFSLE W ?10,*7,"Batch COLOR NOT AVAILABLE for  Data Entry -- Select AGAIN" H 2 S DX=1 X XY X AFSLE G D5

E0 I '$D(AFSHNTRL(AFSHBCLR)) G E0C

 ;

E0C K AFSHBCNT,AFSHDSPL,AFSI,AFSR,AFSRR,AFSRRR,AFSBCNT

 L @AFSLKEXT I '$T S DY=23,DX=1 X XY X AFSLE W ?10,*7,"Export Job Running -- Batch Printing NOT Available" H 2 S DX=1 X XY X AFSLE G D5

 L @AFSLKPGT I '$T U IO(0) W !!,*7,?10,"*****   OTHER USERS ARE ACTIVE -- PLEASE CONTINUE  *****" H 2

BSELECT S AFSCNT=0 K AFSBINFO

 S %DT="AEX",%DT("A")="ENTER BATCH DATE TO PRINT: " D ^%DT  ;ACR*2.1*13.02 IM13574

 I $D(DQOUT) G BSELA

 I $D(DTOUT)!($D(DUOUT)) G EXIT

 I Y="?" G BSELA

 S AFSHBID="" W !! G BSELA1

BSELA S AFSHBDAT=0,AFSHBID="" W !!

BSELA1 S AFSHBDAT=$O(^AFSHRCDS(AFSHBCLR,"D","B",AFSHBDAT)) G BSELEND:AFSHBDAT=""

BSELA2 S AFSHBID=$O(^AFSHRCDS(AFSHBCLR,"D",AFSHBDAT,"I","B",AFSHBID)) G BSELA1:AFSHBID=""

 S AFSHBDFN=0,AFSHBDFN=$O(^AFSHRCDS(AFSHBCLR,"D",AFSHBDAT,"I","B",AFSHBID,AFSHBDFN))

 G BSELA2:AFSHBDFN<1

 S AFSCNT=AFSCNT+1,AFSBINFO(AFSCNT)=AFSHBDAT_"^"_AFSHBDFN

 ;Beginning Y2K fix

 ;W $J(("["_$J(AFSCNT,2)_"] "_$E(AFSHBDAT,4,5)_"/"_$E(AFSHBDAT,6,7)_"/"_$E(AFSHBDAT,2,3)_"-"_AFSHBID_"("_$P(^AFSHRCDS(AFSHBCLR,"D",AFSHBDAT,"I",AFSHBDFN,"S",0),"^",4)_")"),20)

 W $J(("["_$J(AFSCNT,2)_"] "_$E(AFSHBDAT,4,5)_"/"_$E(AFSHBDAT,6,7)_"/"_$E(AFSHBDAT,1,3)+1700_"-"_AFSHBID_"("_$P(^AFSHRCDS(AFSHBCLR,"D",AFSHBDAT,"I",AFSHBDFN,"S",0),"^",4)_")"),20) ;Y2000;HJT;AFSH*3.0T1*1

 ;End Y2K fix block

 G BSELA2

BSELEND W !! S DIR(0)="N^1:"_AFSCNT,DIR("A")="ENTER BATCH SEQUENCE # ([ ]) TO PRINT" D ^DIR

 S AFSHBDAT=$P(AFSBINFO(Y),"^",1),AFSHBDFN=$P(AFSBINFO(Y),"^",2)

 G B0

EXIT G DENTRY^AFSHVKIL

 ;L  Q                                   ; ACR*2.1*13.02 IM13574

 Q                                       ; ACR*2.1*13.02 IM13574

 ;

 ;SBRS     K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT R Y:DTIME I '$T W *7 R Y:5 G SBRS:Y="." I '$T S (DTOUT,Y)="" Q   ; ACR*2.1*13.02 IM13574

 ;S:Y="/.," (DFOUT,Y)="" S:Y="" DLOUT="" S:Y="^" (DUOUT,Y)="" S:Y?1"?".E!(Y["^") S (DQOUT,Y)=""   ; ACR*2.1*13.02 IM13574

 ;Q

SBRS K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT         ; ACR*2.1*13.02 IM13574

 N DIR                                   ; ACR*2.1*13.02 IM13574

 S DIR(0)="F"                            ; ACR*2.1*13.02 IM13574

 D DIR^ACRFDIC                           ; ACR*2.1*13.02 IM13574

 I $D(DTOUT)!($D(DIROUT))!($D(DIRUT))!($D(DUOUT)) S Y="" Q   ; ACR*2.1*13.02 IM13574

 G SBRS:Y="."                            ; ACR*2.1*13.02 IM13574

 S:Y="/.," (DFOUT,Y)="" S:Y="" DLOUT="" S:Y?1"?".E (DQOUT,Y)=""   ; ACR*2.1*13.02 IM13574

 Q

B0 S AFSR=AFSHBCLR,(AFSRR,AFSRRR,AFSRRRR)=0

B1 S AFSRR=$O(^AFSHRCDS(AFSR,"D","B",AFSRR)) G ZEND:+AFSRR=0

B2 S AFSRRR=$O(^AFSHRCDS(AFSR,"D",AFSRR,"I","B",AFSRRR)) G B1:AFSRRR=""

 S AFSRRRP=0,AFSRRRP=$O(^AFSHRCDS(AFSR,"D",AFSRR,"I","B",AFSRRR,AFSRRRP))

 S AFSRRA=$P(^AFSHRCDS(AFSR,"D",AFSRR,"I",AFSRRRP,0),"^",1),AFSHBCNT=$P(^(0),"^",5),AFSHBTOT=$P(^(0),"^",6),AFSHBAP=$P(^(0),"^",2)

 S AFSHBDAT=AFSRR D PCCHDR^AFSHBPR1

 S AFSRRRR=0

B3 S AFSRRRR=$O(^AFSHRCDS(AFSR,"D",AFSRR,"I",AFSRRRP,"S",AFSRRRR)) G BTRL:+AFSRRRR=0

 S AFSHYY=^AFSHRCDS(AFSR,"D",AFSRR,"I",AFSRRRP,"S",AFSRRRR,0)

 I AFSRRRR#100=0 U IO(0) W $J(AFSRRRR,8)

 D ^AFSHEX2

 S AFSHTRCT=AFSHTRCT+1,AFSHPLCT=AFSHPLCT+1

 G B3

BTRL D PCCTRL^AFSHBPR1

 G B2

ZEND D PCCJTRL^AFSQEX1

 I AFSHPLCT>55 D PTRHDR^AFSHEX2

 U AFSHPTRD W !!,?10,"NUMBER OF OUTPUT DHR RECORDS = ",?45,$J(AFSHTRCT,8),!!,?10,"NUMBER OF JCL RECORDS = ",?45,$J(8,8),!!

 S X="",$P(X,"-",44)="" W ?10,X,!,?15,"TOTAL RECORDS TO TRANSMIT = ",?45,$J(AFSHTRCT+8,8),!!

 Q

AFSHBPRT  ; IHS/OIRM/DSD/JDM -DHR BATCH PRINT PROGRAM ;  [ 10/27/2004   4:20 PM ]

 +1       ;;3.0T1;AO FINANCIAL DATA MGMT SYSTEM;**1,13**;FEB 02, 1999

 +2       ;;MODIFIED FOR CACHE' COMPLIANCE ; ACR*2.1*9

 +3        DO CRTSETUP^AFSHCRTS

A0         DO ^XBCLS

 +1        FOR I=1:1:70

               WRITE "*"

 +2        WRITE !,?10,"Document History Record (DHR) Batch Print Program",!

 +3        FOR I=1:1:70

               WRITE "*"

 +4        WRITE !!

D5         SET DY=22

           SET DX=1

           XECUTE XY

           XECUTE AFSLE

           WRITE ?10,"Enter Batch COLOR to USE: (B/R) ('^' to EXIT) "

 +1        SET DX=60

           SET %L=1

           SET %F="I"

           SET %T="A"

           XECUTE XY

           XECUTE AFSAD

           DO ^AFSHDAT1

 +2        IF AFSX1="^"

               GOTO EXIT

 +3        IF "BR"'[AFSX1!(AFSX1="")

               SET DX=55

               XECUTE XY

               XECUTE AFSLE

               WRITE *7,"  INVALID ENTRY"

               HANG 2

               GOTO D5

 +4        SET AFSLKEN="AFSEND"_$EXTRACT(AFSHDTYP,1,1)_AFSX1_"("_$JOB_")"

           SET AFSLKENT=AFSLKEN_":1"

 +5        SET AFSLKPGT="AFSEND"_$EXTRACT(AFSHDTYP,1,1)_AFSX1_":1"

 +6        SET AFSLKEXT="AFSEXDHR("_""""_$EXTRACT(AFSHDTYP,1,1)_AFSX1_"""):1"

 +7        IF AFSHDTYP="PCC"

               SET AFSHBCLR=$SELECT(AFSX1="B":1,AFSX1="R":2)

 +8        IF AFSHDTYP="BCS"

               SET AFSHBCLR=$SELECT(AFSX1="B":3,AFSX1="R":4)

 +9       ; TEMP ARMS TEST

           IF AFSHDTYP="ARM"

               SET AFSHBCLR=$SELECT(AFSX1="B":5,AFSX1="R":6)

D6         IF '$DATA(AFSHBCNT(AFSHBCLR))

               GOTO E0

 +1        IF $PIECE(AFSHBCNT(AFSHBCLR,"STATUS"),"^",1)'="T"

               GOTO E0

 +2        SET DY=23

           SET DX=1

           XECUTE XY

           XECUTE AFSLE

           WRITE ?10,*7,"Batch COLOR NOT AVAILABLE for  Data Entry -- Select AGAIN"

           HANG 2

           SET DX=1

           XECUTE XY

           XECUTE AFSLE

           GOTO D5

E0         IF '$DATA(AFSHNTRL(AFSHBCLR))

               GOTO E0C

 +1       ;

E0C        KILL AFSHBCNT,AFSHDSPL,AFSI,AFSR,AFSRR,AFSRRR,AFSBCNT

 +1        LOCK @AFSLKEXT

           IF '$TEST

               SET DY=23

               SET DX=1

               XECUTE XY

               XECUTE AFSLE

               WRITE ?10,*7,"Export Job Running -- Batch Printing NOT Available"

               HANG 2

               SET DX=1

               XECUTE XY

               XECUTE AFSLE

               GOTO D5

 +2        LOCK @AFSLKPGT

           IF '$TEST

               USE IO(0)

               WRITE !!,*7,?10,"*****   OTHER USERS ARE ACTIVE -- PLEASE CONTINUE  *****"

               HANG 2

BSELECT    SET AFSCNT=0

           KILL AFSBINFO

 +1       ;ACR*2.1*13.02 IM13574

           SET %DT="AEX"

           SET %DT("A")="ENTER BATCH DATE TO PRINT: "

           DO ^%DT

 +2        IF $DATA(DQOUT)

               GOTO BSELA

 +3        IF $DATA(DTOUT)!($DATA(DUOUT))

               GOTO EXIT

 +4        IF Y="?"

               GOTO BSELA

 +5        SET AFSHBID=""

           WRITE !!

           GOTO BSELA1

BSELA      SET AFSHBDAT=0

           SET AFSHBID=""

           WRITE !!

BSELA1     SET AFSHBDAT=$ORDER(^AFSHRCDS(AFSHBCLR,"D","B",AFSHBDAT))

           IF AFSHBDAT=""

               GOTO BSELEND

BSELA2     SET AFSHBID=$ORDER(^AFSHRCDS(AFSHBCLR,"D",AFSHBDAT,"I","B",AFSHBID))

           IF AFSHBID=""

               GOTO BSELA1

 +1        SET AFSHBDFN=0

           SET AFSHBDFN=$ORDER(^AFSHRCDS(AFSHBCLR,"D",AFSHBDAT,"I","B",AFSHBID,AFSHBDFN))

 +2        IF AFSHBDFN<1

               GOTO BSELA2

 +3        SET AFSCNT=AFSCNT+1

           SET AFSBINFO(AFSCNT)=AFSHBDAT_"^"_AFSHBDFN

 +4       ;Beginning Y2K fix

 +5       ;W $J(("["_$J(AFSCNT,2)_"] "_$E(AFSHBDAT,4,5)_"/"_$E(AFSHBDAT,6,7)_"/"_$E(AFSHBDAT,2,3)_"-"_AFSHBID_"("_$P(^AFSHRCDS(AFSHBCLR,"D",AFSHBDAT,"I",AFSHBDFN,"S",0),"^",4)_")"),20)

 +6       ;Y2000;HJT;AFSH*3.0T1*1

           WRITE $JUSTIFY(("["_$JUSTIFY(AFSCNT,2)_"] "_$EXTRACT(AFSHBDAT,4,5)_"/"_$EXTRACT(AFSHBDAT,6,7)_"/"_$EXTRACT(AFSHBDAT,1,3)+1700_"-"_AFSHBID_"("_$PIECE(^AFSHRCDS(AFSHBCLR,"D",AFSHBDAT,"I",AFSHBDFN,"S",0),"^",4)_")"),20)

 +7       ;End Y2K fix block

 +8        GOTO BSELA2

BSELEND    WRITE !!

           SET DIR(0)="N^1:"_AFSCNT

           SET DIR("A")="ENTER BATCH SEQUENCE # ([ ]) TO PRINT"

           DO ^DIR

 +1        SET AFSHBDAT=$PIECE(AFSBINFO(Y),"^",1)

           SET AFSHBDFN=$PIECE(AFSBINFO(Y),"^",2)

 +2        GOTO B0

EXIT       GOTO DENTRY^AFSHVKIL

 +1       ;L  Q                                   ; ACR*2.1*13.02 IM13574

 +2       ; ACR*2.1*13.02 IM13574

           QUIT 

 +3       ;

 +4       ;SBRS     K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT R Y:DTIME I '$T W *7 R Y:5 G SBRS:Y="." I '$T S (DTOUT,Y)="" Q   ; ACR*2.1*13.02 IM13574

 +5       ;S:Y="/.," (DFOUT,Y)="" S:Y="" DLOUT="" S:Y="^" (DUOUT,Y)="" S:Y?1"?".E!(Y["^") S (DQOUT,Y)=""   ; ACR*2.1*13.02 IM13574

 +6       ;Q

SBRS      ; ACR*2.1*13.02 IM13574

           KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT

 +1       ; ACR*2.1*13.02 IM13574

           NEW DIR

 +2       ; ACR*2.1*13.02 IM13574

           SET DIR(0)="F"

 +3       ; ACR*2.1*13.02 IM13574

           DO DIR^ACRFDIC

 +4       ; ACR*2.1*13.02 IM13574

           IF $DATA(DTOUT)!($DATA(DIROUT))!($DATA(DIRUT))!($DATA(DUOUT))

               SET Y=""

               QUIT 

 +5       ; ACR*2.1*13.02 IM13574

           IF Y="."

               GOTO SBRS

 +6       ; ACR*2.1*13.02 IM13574

           IF Y="/.,"

               SET (DFOUT,Y)=""

           IF Y=""

               SET DLOUT=""

           IF Y?1"?".E

               SET (DQOUT,Y)=""

 +7        QUIT 

B0         SET AFSR=AFSHBCLR

           SET (AFSRR,AFSRRR,AFSRRRR)=0

B1         SET AFSRR=$ORDER(^AFSHRCDS(AFSR,"D","B",AFSRR))

           IF +AFSRR=0

               GOTO ZEND

B2         SET AFSRRR=$ORDER(^AFSHRCDS(AFSR,"D",AFSRR,"I","B",AFSRRR))

           IF AFSRRR=""

               GOTO B1

 +1        SET AFSRRRP=0

           SET AFSRRRP=$ORDER(^AFSHRCDS(AFSR,"D",AFSRR,"I","B",AFSRRR,AFSRRRP))

 +2        SET AFSRRA=$PIECE(^AFSHRCDS(AFSR,"D",AFSRR,"I",AFSRRRP,0),"^",1)

           SET AFSHBCNT=$PIECE(^(0),"^",5)

           SET AFSHBTOT=$PIECE(^(0),"^",6)

           SET AFSHBAP=$PIECE(^(0),"^",2)

 +3        SET AFSHBDAT=AFSRR

           DO PCCHDR^AFSHBPR1

 +4        SET AFSRRRR=0

B3         SET AFSRRRR=$ORDER(^AFSHRCDS(AFSR,"D",AFSRR,"I",AFSRRRP,"S",AFSRRRR))

           IF +AFSRRRR=0

               GOTO BTRL

 +1        SET AFSHYY=^AFSHRCDS(AFSR,"D",AFSRR,"I",AFSRRRP,"S",AFSRRRR,0)

 +2        IF AFSRRRR#100=0

               USE IO(0)

               WRITE $JUSTIFY(AFSRRRR,8)

 +3        DO ^AFSHEX2

 +4        SET AFSHTRCT=AFSHTRCT+1

           SET AFSHPLCT=AFSHPLCT+1

 +5        GOTO B3

BTRL       DO PCCTRL^AFSHBPR1

 +1        GOTO B2

ZEND       DO PCCJTRL^AFSQEX1

 +1        IF AFSHPLCT>55

               DO PTRHDR^AFSHEX2

 +2        USE AFSHPTRD

           WRITE !!,?10,"NUMBER OF OUTPUT DHR RECORDS = ",?45,$JUSTIFY(AFSHTRCT,8),!!,?10,"NUMBER OF JCL RECORDS = ",?45,$JUSTIFY(8,8),!!

 +3        SET X=""

           SET $PIECE(X,"-",44)=""

           WRITE ?10,X,!,?15,"TOTAL RECORDS TO TRANSMIT = ",?45,$JUSTIFY(AFSHTRCT+8,8),!!

 +4        QUIT