ABPACLHD ;PRINT CHECK LOG HEADING; [ 08/07/91 9:16 AM ]
;;1.4;AO PVT-INS TRACKING;*1*;IHS-OKC/KJR;AUGUST 7, 1991
;;PATCH 1: END+19 MODIFIED TO STUFF 'YES';IHS-OKC/KJR;07AUG91
HEAD W @IOF S ABPAPG=ABPAPG+1 D CHECK^ABPAOPT I +ABPAOPT(5)>0 D
.F I=1:1:+ABPAOPT(5) W !
W ?55,"PAGE ",ABPAPG F I=1:1:5 W !
W ?12,+$E(DT,4,5)_"/"_+$E(DT,6,7)_"/"_+$E(DT,2,3),!!,?12,ABPAOPT(3)
W !!!,?12,"Private Insurance Collections"," - ",ACCTPT,!!
W ?12,"Finance",!?12,$P(^DIC(4,DUZ(2),0),"^"),!!!!
W ?12,"Collections listed below totaling " S X=ABPA("SUM"),X2="2$"
S X3=11 D COMMA^%DTC W X," are transmitted"
W !,?12,"herewith for appropriate action.",!!!
W ?5,"RECEIVED",?16,"CHECK #",?33,"PAYOR",?68,"AMOUNT",!
W ?5,"________",?16,"_______",?33,"_______",?68,"______",!
Q
;--------------------------------------------------------------------
END ;PROCEDURE TO PROCESS THE FINAL TASK DURING PRINTING OF THE CHECK LOG
I $Y>46 W @IOF S ABPAPG=ABPAPG+1 W ?55,"PAGE ",ABPAPG,!!!!!!!!
I $D(FINAL)=1 I 'FINAL D Q
.S X="* * * D R A F T C O P Y O N L Y * * *"
.S Y="*******************************************"
.W !!!!!?(40-($L(Y)/2)),Y,!?(40-($L(X)/2)),X,!?(40-($L(Y)/2)),Y,@IOF
W !!!!?45,ABPAOPT(4),!,?45,ABPAOPT(10)
W !?45,$P(^DIC(4,DUZ(2),0),"^")
W !!!?5,"RECEIPT FOR $ __________________ IS HEREBY ACKNOWLEDGED."
W !!!?45,"____________________",!?45,"Financial Management"
D ^%AUCLS
;--------------------------------------------------------------------
;PROCEDURE TO FLAG CHECKS AS HAVING BEEN REPORTED ON A TRANSMITTAL
I $D(FINAL)=1 I FINAL K DIE,DR,DA D
.S DA(2)=DA2,DA(1)=0 F J=0:0 D Q:+DA(1)=0
..S DA(1)=$O(^ABPACHKS("TR",ABPADT,"N",DA(2),DA(1))) Q:+DA(1)=0
..S DA=0 F K=0:0 D Q:+DA=0
...S DA=$O(^ABPACHKS("TR",ABPADT,"N",DA(2),DA(1),DA)) Q:+DA=0
...S DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","
...S DR="11///YES" D ^DIE
.;------------------------------------------------------------------
.;PROCEDURE TO CREATE BATCH DATE FOR THIS TRANSMITTAL DATE
.S R=0,LGTOT=0,DA2=1 F I=0:0 D Q:+R=0
..S R=$O(^ABPACHKS("RB",DA2,R)) Q:+R=0
..S RR=0 F J=0:0 D Q:+RR=0
...S RR=$O(^ABPACHKS("RB",DA2,R,RR)) Q:+RR=0
...Q:$D(^ABPACHKS(DA2,"I",R,"C",RR,0))'=1
...S LGDT=$P(^ABPACHKS(DA2,"I",R,"C",RR,0),"^",2)
...S LGDT=$P(LGDT,".") Q:LGDT'=ABPADT
...S LGTOT=LGTOT+(+^ABPACHKS("RB",DA2,R,RR))
.K DIC,DA S DIC="^ABPAPBAT(",DIC(0)="LZ",X=ABPADT D ^DIC
.I +$P(Y,"^",3)>0 D
..S ^ABPAPBAT(+Y,0)=^ABPAPBAT(+Y,0)_"^0^0^0^O^"_DUZ_"^"_DT
..F ABPAJ=11:1:14 S $P(^ABPAPBAT(+Y,0),"^",ABPAJ)=0
..K DIK,DA S DIK="^ABPAPBAT(",DA=+Y D IX^DIK K DIC,DIK,DA
..S P10=+$P(^ABPAPBAT(+Y,0),"^",10),P10=P10+LGTOT
..S $P(^ABPAPBAT(+Y,0),"^",10)=P10
.;------------------------------------------------------------------
.;PROCEDURE TO PROCESS ANY CORRECTIONS TO PREVIOUS CHECK LOGS
.D MAIN^ABPACLG4 K ^TMP("ABPACLG1")
ABPACLHD ;PRINT CHECK LOG HEADING; [ 08/07/91 9:16 AM ]
+1 ;;1.4;AO PVT-INS TRACKING;*1*;IHS-OKC/KJR;AUGUST 7, 1991
+2 ;;PATCH 1: END+19 MODIFIED TO STUFF 'YES';IHS-OKC/KJR;07AUG91
HEAD WRITE @IOF
SET ABPAPG=ABPAPG+1
DO CHECK^ABPAOPT
IF +ABPAOPT(5)>0
Begin DoDot:1
+1 FOR I=1:1:+ABPAOPT(5)
WRITE !
End DoDot:1
+2 WRITE ?55,"PAGE ",ABPAPG
FOR I=1:1:5
WRITE !
+3 WRITE ?12,+$EXTRACT(DT,4,5)_"/"_+$EXTRACT(DT,6,7)_"/"_+$EXTRACT(DT,2,3),!!,?12,ABPAOPT(3)
+4 WRITE !!!,?12,"Private Insurance Collections"," - ",ACCTPT,!!
+5 WRITE ?12,"Finance",!?12,$PIECE(^DIC(4,DUZ(2),0),"^"),!!!!
+6 WRITE ?12,"Collections listed below totaling "
SET X=ABPA("SUM")
SET X2="2$"
+7 SET X3=11
DO COMMA^%DTC
WRITE X," are transmitted"
+8 WRITE !,?12,"herewith for appropriate action.",!!!
+9 WRITE ?5,"RECEIVED",?16,"CHECK #",?33,"PAYOR",?68,"AMOUNT",!
+10 WRITE ?5,"________",?16,"_______",?33,"_______",?68,"______",!
+11 QUIT
+12 ;--------------------------------------------------------------------
END ;PROCEDURE TO PROCESS THE FINAL TASK DURING PRINTING OF THE CHECK LOG
+1 IF $Y>46
WRITE @IOF
SET ABPAPG=ABPAPG+1
WRITE ?55,"PAGE ",ABPAPG,!!!!!!!!
+2 IF $DATA(FINAL)=1
IF 'FINAL
Begin DoDot:1
+3 SET X="* * * D R A F T C O P Y O N L Y * * *"
+4 SET Y="*******************************************"
+5 WRITE !!!!!?(40-($LENGTH(Y)/2)),Y,!?(40-($LENGTH(X)/2)),X,!?(40-($LENGTH(Y)/2)),Y,@IOF
End DoDot:1
QUIT
+6 WRITE !!!!?45,ABPAOPT(4),!,?45,ABPAOPT(10)
+7 WRITE !?45,$PIECE(^DIC(4,DUZ(2),0),"^")
+8 WRITE !!!?5,"RECEIPT FOR $ __________________ IS HEREBY ACKNOWLEDGED."
+9 WRITE !!!?45,"____________________",!?45,"Financial Management"
+10 DO ^%AUCLS
+11 ;--------------------------------------------------------------------
+12 ;PROCEDURE TO FLAG CHECKS AS HAVING BEEN REPORTED ON A TRANSMITTAL
+13 IF $DATA(FINAL)=1
IF FINAL
KILL DIE,DR,DA
Begin DoDot:1
+14 SET DA(2)=DA2
SET DA(1)=0
FOR J=0:0
Begin DoDot:2
+15 SET DA(1)=$ORDER(^ABPACHKS("TR",ABPADT,"N",DA(2),DA(1)))
IF +DA(1)=0
QUIT
+16 SET DA=0
FOR K=0:0
Begin DoDot:3
+17 SET DA=$ORDER(^ABPACHKS("TR",ABPADT,"N",DA(2),DA(1),DA))
IF +DA=0
QUIT
+18 SET DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","
+19 SET DR="11///YES"
DO ^DIE
End DoDot:3
IF +DA=0
QUIT
End DoDot:2
IF +DA(1)=0
QUIT
+20 ;------------------------------------------------------------------
+21 ;PROCEDURE TO CREATE BATCH DATE FOR THIS TRANSMITTAL DATE
+22 SET R=0
SET LGTOT=0
SET DA2=1
FOR I=0:0
Begin DoDot:2
+23 SET R=$ORDER(^ABPACHKS("RB",DA2,R))
IF +R=0
QUIT
+24 SET RR=0
FOR J=0:0
Begin DoDot:3
+25 SET RR=$ORDER(^ABPACHKS("RB",DA2,R,RR))
IF +RR=0
QUIT
+26 IF $DATA(^ABPACHKS(DA2,"I",R,"C",RR,0))'=1
QUIT
+27 SET LGDT=$PIECE(^ABPACHKS(DA2,"I",R,"C",RR,0),"^",2)
+28 SET LGDT=$PIECE(LGDT,".")
IF LGDT'=ABPADT
QUIT
+29 SET LGTOT=LGTOT+(+^ABPACHKS("RB",DA2,R,RR))
End DoDot:3
IF +RR=0
QUIT
End DoDot:2
IF +R=0
QUIT
+30 KILL DIC,DA
SET DIC="^ABPAPBAT("
SET DIC(0)="LZ"
SET X=ABPADT
DO ^DIC
+31 IF +$PIECE(Y,"^",3)>0
Begin DoDot:2
+32 SET ^ABPAPBAT(+Y,0)=^ABPAPBAT(+Y,0)_"^0^0^0^O^"_DUZ_"^"_DT
+33 FOR ABPAJ=11:1:14
SET $PIECE(^ABPAPBAT(+Y,0),"^",ABPAJ)=0
+34 KILL DIK,DA
SET DIK="^ABPAPBAT("
SET DA=+Y
DO IX^DIK
KILL DIC,DIK,DA
+35 SET P10=+$PIECE(^ABPAPBAT(+Y,0),"^",10)
SET P10=P10+LGTOT
+36 SET $PIECE(^ABPAPBAT(+Y,0),"^",10)=P10
End DoDot:2
+37 ;------------------------------------------------------------------
+38 ;PROCEDURE TO PROCESS ANY CORRECTIONS TO PREVIOUS CHECK LOGS
+39 DO MAIN^ABPACLG4
KILL ^TMP("ABPACLG1")
End DoDot:1
