ABPACLG0 ;CHECK LOGGING UTILITY; [ 07/09/91 4:28 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
Q ;;NOT AN ENTRY POINT
;---------------------------------------------------------------------
CLEAR ;PROCEDURE TO KILL ALL TEMPORARY LOCAL VARIABLES
K X,Y,ABPA("HD"),DIC,DIE,DA,DR,ABPADFN,ABPAC,NOINS,NOCHECK,ABPAINS
K NOACCT,LDT,LLDT,ABPAM,ABPAL,ABPAJ,ABPAK,ABPACAP
Q
;---------------------------------------------------------------------
HEAD ;PROCEDURE TO DRAW SCREEN HEADING
K ABPA("HD") S ABPA("HD",1)=ABPATLE
S ABPA("HD",2)="LOG third party CHECKS - "_+$E(LOGDT,4,5)_"/"
S ABPA("HD",2)=ABPA("HD",2)_+$E(LOGDT,6,7)_"/"_+$E(LOGDT,2,3)
D ^ABPAHD
Q
;--------------------------------------------------------------------
GETCHK ;PROCEDURE TO GET CHECK DATA
F ABPAK=0:0 S NOACCT=0,LOGDT=DT D I NOACCT Q
.K DIC,DA,ABPADFN,ABPAINS,ACCTPT
.W ! S DX=0,DY=8 X XY D EOP^ABPAMAIN
.S DIC="^ABPACHKS(",DIC(0)="AQZ"
.S DIC("A")="Select ACCOUNTING POINT: " W !! D ^DIC
.I +Y<1 S NOACCT=1 Q
.S ABPADFN(1)=+Y,ACCTPT="ACCOUNTING POINT = "_Y(0,0)
.W ! S DX=0,DY=8 X XY D EOP^ABPAMAIN W !?(40-($L(ACCTPT)/2)),ACCTPT
.I $D(^ABPACHKS(ABPADFN(1),"I",0))'=1 D
..S ^ABPACHKS(ABPADFN(1),"I",0)="^9002270.31PA^^"
.;------------------------------------------------------------------
.;PROCEDURE TO VERIFY PRINTING OF 'FINAL' COPIES OF TRANSMITTALS
.S LLDT=$O(^ABPACHKS("TR",""))
.I +LLDT>0,+LLDT<+DT,$D(^ABPACHKS("TR",LLDT,"N",ABPADFN(1)))'=0 D
..S DX=0,DY=21 X XY W !,*7
..W @(ABPARON),"*** WARNING *** SWITCHING TO THE ACTIVE LOG DATED "
..W +$E(LLDT,4,5),"/",+$E(LLDT,6,7),"/",+$E(LLDT,2,3),@(ABPAROFF)
..K DIR S DIR(0)="EA",DIR("A")="Press [RETURN] to continue "
..D ^DIR S LOGDT=LLDT D HEAD
..W ! S DX=0,DY=8 X XY D EOP^ABPAMAIN W !?(40-($L(ACCTPT)/2)),ACCTPT
.;------------------------------------------------------------------
.;PROCEDURE TO CHECK FOR EXISTING PAYMENT BATCH
.I $D(^ABPAPBAT(LOGDT,0))=1 W !!!?7 D Q
..W *7,"<<< PAYMENT BATCH '",+$E(LOGDT,4,5)_"/"_+$E(LOGDT,6,7)_"/"
..W +$E(LOGDT,2,3),"' ALREADY EXIST - SESSION ABORTED >>>" H 3
.;------------------------------------------------------------------
.F ABPAL=0:0 S NOINS=0 D I NOINS S LOGDT=DT D HEAD Q
..S DX=0,DY=10 X XY D EOP^ABPAMAIN
..K DIC,DA S DA(1)=ABPADFN(1),DIC="^ABPACHKS("_DA(1)_",""I"","
..S DIC(0)="AELQZ" I LOGDT'=DT S DIC(0)="AEQZ"
..S DIC("A")="Select THIRD PARTY PAYOR: " W !! D ^DIC
..I +Y<1 S NOINS=1 Q
..S ABPADFN(2)=+Y,ABPAINS="*** "_Y(0,0)_" ***" I $Y<58 D
...D HEAD W ! S DX=0,DY=8 X XY D EOP^ABPAMAIN
...W !?(40-($L(ACCTPT)/2)),ACCTPT
..S DX=0,DY=10 X XY D EOP^ABPAMAIN W !?(40-($L(ABPAINS)/2)),ABPAINS
..I $D(^ABPACHKS(ABPADFN(1),"I",ABPADFN(2),"C",0))'=1 D
...S ^ABPACHKS(ABPADFN(1),"I",ABPADFN(2),"C",0)="^9002270.311AI^^"
..S ABPACAP=ACCTPT
..F ABPAM=0:0 D I 'GOTCHECK I ABPACHK="" S ACCTPT=ABPACAP Q
...S DX=0,DY=12 X XY D EOP^ABPAMAIN
...S RESTRICT=1,ABPASCR="I RR'=ABPADFN(2) S QFLG=""""",ABPA("LOG")=1
...D MAIN^ABPACKLK I 'GOTCHECK I ABPACHK="" Q
...I $A($E(X,1))=34!($A($E(X,$L(X)))=34) D Q
....S ABPAMESS="'FORCING' DUPLICATE ENTRIES NOT ALLOWED"
....S ABPAMESS(2)="... Press any key to continue ..."
....W *7 D PAUSE^ABPAMAIN
...I 'GOTCHECK I LOGDT'=DT D Q
....S ABPAMESS="YOU CANNOT ADD NEW ENTRIES TO AN OLD LOG "
....S ABPAMESS(2)="... Press any key to continue ..."
....W *7 D PAUSE^ABPAMAIN
...I 'GOTCHECK Q:Y']"" I $D(Y(0))=1 Q:Y(0)="NO"
...K DIC,DA S DA(2)=ABPADFN(1),DA(1)=ABPADFN(2)
...S DIC="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"",",DIC("DR")=3
...S DIC(0)="LZ" I LOGDT'=DT S DIC(0)="Z"
...I GOTCHECK S X=ABPACHK("NUM")
...W ! D ^DIC Q:+Y<1 S GOTCHECK=+Y
...I +$P(Y,"^",3)'=1 D W ! Q
....;-------------------------------------------------------------
....;PROCEDURE TO EDIT A EXISTING LOG ENTRY
....K DIC,DIE,DA,DR
....S ABPADFN(3)=+Y,DA(2)=ABPADFN(1),DA(1)=ABPADFN(2)
....S DA=ABPADFN(3)
....S LDT=$P($P(^ABPACHKS(DA(2),"I",DA(1),"C",DA,0),"^",2),".")
....I $D(^ABPACHKS("TR",LDT,"N",DA(2),DA(1),DA))'=1 D Q
.....W *7,!?5,"<<< NO EDITING ALLOWED >>>" H 2
....S DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","
....S DR=".01;3;" I $D(ABPAOPT(1))=11 I ABPAOPT(1)="Y" S DR=DR_"14;"
....S DR=DR_"6///N;7///0" W ! D ^DIE I $D(DA)=0 D Q
.....K ^ABPACHKS("RB",ABPADFN(1),ABPADFN(2),ABPADFN(3))
....S RBAL=$P(^ABPACHKS(DA(2),"I",DA(1),"C",DA,0),"^",4)
....S DR="4///"_DUZ_";5///NOW;8///"_+RBAL_";11///N" D ^DIE
....;-------------------------------------------------------------
...K DIC,DIE,DR,DA
...S ABPADFN(3)=+Y,DA(2)=ABPADFN(1),DA(1)=ABPADFN(2),DA=ABPADFN(3)
...S DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"",",DIE("NO^")=""
...S DR=".01;3;" I $D(ABPAOPT(1))=11 I ABPAOPT(1)="Y" S DR=DR_"14;"
...S DR=DR_"1///NOW;2///"_DUZ_";6///N;7///0" W ! D ^DIE
...Q:$D(DA)=0 S RBAL=$P(^ABPACHKS(DA(2),"I",DA(1),"C",DA,0),"^",4)
...S RBAL=RBAL-$P(^ABPACHKS(DA(2),"I",DA(1),"C",DA,0),"^",8)
...S DR="4///"_DUZ_";5///NOW;8///"_+RBAL_";11///N" D ^DIE
Q
;--------------------------------------------------------------------
MAIN ;MAIN ROUTINE DRIVER PROCEDURE
F ABPAJ=0:0 D CLEAR S LOGDT=DT D HEAD S NOACCT=0 D GETCHK I NOACCT Q
D CLEAR K I
Q
ABPACLG0 ;CHECK LOGGING UTILITY; [ 07/09/91 4:28 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 ;;NOT AN ENTRY POINT
QUIT
+3 ;---------------------------------------------------------------------
CLEAR ;PROCEDURE TO KILL ALL TEMPORARY LOCAL VARIABLES
+1 KILL X,Y,ABPA("HD"),DIC,DIE,DA,DR,ABPADFN,ABPAC,NOINS,NOCHECK,ABPAINS
+2 KILL NOACCT,LDT,LLDT,ABPAM,ABPAL,ABPAJ,ABPAK,ABPACAP
+3 QUIT
+4 ;---------------------------------------------------------------------
HEAD ;PROCEDURE TO DRAW SCREEN HEADING
+1 KILL ABPA("HD")
SET ABPA("HD",1)=ABPATLE
+2 SET ABPA("HD",2)="LOG third party CHECKS - "_+$EXTRACT(LOGDT,4,5)_"/"
+3 SET ABPA("HD",2)=ABPA("HD",2)_+$EXTRACT(LOGDT,6,7)_"/"_+$EXTRACT(LOGDT,2,3)
+4 DO ^ABPAHD
+5 QUIT
+6 ;--------------------------------------------------------------------
GETCHK ;PROCEDURE TO GET CHECK DATA
+1 FOR ABPAK=0:0
SET NOACCT=0
SET LOGDT=DT
Begin DoDot:1
+2 KILL DIC,DA,ABPADFN,ABPAINS,ACCTPT
+3 WRITE !
SET DX=0
SET DY=8
XECUTE XY
DO EOP^ABPAMAIN
+4 SET DIC="^ABPACHKS("
SET DIC(0)="AQZ"
+5 SET DIC("A")="Select ACCOUNTING POINT: "
WRITE !!
DO ^DIC
+6 IF +Y<1
SET NOACCT=1
QUIT
+7 SET ABPADFN(1)=+Y
SET ACCTPT="ACCOUNTING POINT = "_Y(0,0)
+8 WRITE !
SET DX=0
SET DY=8
XECUTE XY
DO EOP^ABPAMAIN
WRITE !?(40-($LENGTH(ACCTPT)/2)),ACCTPT
+9 IF $DATA(^ABPACHKS(ABPADFN(1),"I",0))'=1
Begin DoDot:2
+10 SET ^ABPACHKS(ABPADFN(1),"I",0)="^9002270.31PA^^"
End DoDot:2
+11 ;------------------------------------------------------------------
+12 ;PROCEDURE TO VERIFY PRINTING OF 'FINAL' COPIES OF TRANSMITTALS
+13 SET LLDT=$ORDER(^ABPACHKS("TR",""))
+14 IF +LLDT>0
IF +LLDT<+DT
IF $DATA(^ABPACHKS("TR",LLDT,"N",ABPADFN(1)))'=0
Begin DoDot:2
+15 SET DX=0
SET DY=21
XECUTE XY
WRITE !,*7
+16 WRITE @(ABPARON),"*** WARNING *** SWITCHING TO THE ACTIVE LOG DATED "
+17 WRITE +$EXTRACT(LLDT,4,5),"/",+$EXTRACT(LLDT,6,7),"/",+$EXTRACT(LLDT,2,3),@(ABPAROFF)
+18 KILL DIR
SET DIR(0)="EA"
SET DIR("A")="Press [RETURN] to continue "
+19 DO ^DIR
SET LOGDT=LLDT
DO HEAD
+20 WRITE !
SET DX=0
SET DY=8
XECUTE XY
DO EOP^ABPAMAIN
WRITE !?(40-($LENGTH(ACCTPT)/2)),ACCTPT
End DoDot:2
+21 ;------------------------------------------------------------------
+22 ;PROCEDURE TO CHECK FOR EXISTING PAYMENT BATCH
+23 IF $DATA(^ABPAPBAT(LOGDT,0))=1
WRITE !!!?7
Begin DoDot:2
+24 WRITE *7,"<<< PAYMENT BATCH '",+$EXTRACT(LOGDT,4,5)_"/"_+$EXTRACT(LOGDT,6,7)_"/"
+25 WRITE +$EXTRACT(LOGDT,2,3),"' ALREADY EXIST - SESSION ABORTED >>>"
HANG 3
End DoDot:2
QUIT
+26 ;------------------------------------------------------------------
+27 FOR ABPAL=0:0
SET NOINS=0
Begin DoDot:2
+28 SET DX=0
SET DY=10
XECUTE XY
DO EOP^ABPAMAIN
+29 KILL DIC,DA
SET DA(1)=ABPADFN(1)
SET DIC="^ABPACHKS("_DA(1)_",""I"","
+30 SET DIC(0)="AELQZ"
IF LOGDT'=DT
SET DIC(0)="AEQZ"
+31 SET DIC("A")="Select THIRD PARTY PAYOR: "
WRITE !!
DO ^DIC
+32 IF +Y<1
SET NOINS=1
QUIT
+33 SET ABPADFN(2)=+Y
SET ABPAINS="*** "_Y(0,0)_" ***"
IF $Y<58
Begin DoDot:3
+34 DO HEAD
WRITE !
SET DX=0
SET DY=8
XECUTE XY
DO EOP^ABPAMAIN
+35 WRITE !?(40-($LENGTH(ACCTPT)/2)),ACCTPT
End DoDot:3
+36 SET DX=0
SET DY=10
XECUTE XY
DO EOP^ABPAMAIN
WRITE !?(40-($LENGTH(ABPAINS)/2)),ABPAINS
+37 IF $DATA(^ABPACHKS(ABPADFN(1),"I",ABPADFN(2),"C",0))'=1
Begin DoDot:3
+38 SET ^ABPACHKS(ABPADFN(1),"I",ABPADFN(2),"C",0)="^9002270.311AI^^"
End DoDot:3
+39 SET ABPACAP=ACCTPT
+40 FOR ABPAM=0:0
Begin DoDot:3
+41 SET DX=0
SET DY=12
XECUTE XY
DO EOP^ABPAMAIN
+42 SET RESTRICT=1
SET ABPASCR="I RR'=ABPADFN(2) S QFLG="""""
SET ABPA("LOG")=1
+43 DO MAIN^ABPACKLK
IF 'GOTCHECK
IF ABPACHK=""
QUIT
+44 IF $ASCII($EXTRACT(X,1))=34!($ASCII($EXTRACT(X,$LENGTH(X)))=34)
Begin DoDot:4
+45 SET ABPAMESS="'FORCING' DUPLICATE ENTRIES NOT ALLOWED"
+46 SET ABPAMESS(2)="... Press any key to continue ..."
+47 WRITE *7
DO PAUSE^ABPAMAIN
End DoDot:4
QUIT
+48 IF 'GOTCHECK
IF LOGDT'=DT
Begin DoDot:4
+49 SET ABPAMESS="YOU CANNOT ADD NEW ENTRIES TO AN OLD LOG "
+50 SET ABPAMESS(2)="... Press any key to continue ..."
+51 WRITE *7
DO PAUSE^ABPAMAIN
End DoDot:4
QUIT
+52 IF 'GOTCHECK
IF Y']""
QUIT
IF $DATA(Y(0))=1
IF Y(0)="NO"
QUIT
+53 KILL DIC,DA
SET DA(2)=ABPADFN(1)
SET DA(1)=ABPADFN(2)
+54 SET DIC="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","
SET DIC("DR")=3
+55 SET DIC(0)="LZ"
IF LOGDT'=DT
SET DIC(0)="Z"
+56 IF GOTCHECK
SET X=ABPACHK("NUM")
+57 WRITE !
DO ^DIC
IF +Y<1
QUIT
SET GOTCHECK=+Y
+58 IF +$PIECE(Y,"^",3)'=1
Begin DoDot:4
+59 ;-------------------------------------------------------------
+60 ;PROCEDURE TO EDIT A EXISTING LOG ENTRY
+61 KILL DIC,DIE,DA,DR
+62 SET ABPADFN(3)=+Y
SET DA(2)=ABPADFN(1)
SET DA(1)=ABPADFN(2)
+63 SET DA=ABPADFN(3)
+64 SET LDT=$PIECE($PIECE(^ABPACHKS(DA(2),"I",DA(1),"C",DA,0),"^",2),".")
+65 IF $DATA(^ABPACHKS("TR",LDT,"N",DA(2),DA(1),DA))'=1
Begin DoDot:5
+66 WRITE *7,!?5,"<<< NO EDITING ALLOWED >>>"
HANG 2
End DoDot:5
QUIT
+67 SET DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","
+68 SET DR=".01;3;"
IF $DATA(ABPAOPT(1))=11
IF ABPAOPT(1)="Y"
SET DR=DR_"14;"
+69 SET DR=DR_"6///N;7///0"
WRITE !
DO ^DIE
IF $DATA(DA)=0
Begin DoDot:5
+70 KILL ^ABPACHKS("RB",ABPADFN(1),ABPADFN(2),ABPADFN(3))
End DoDot:5
QUIT
+71 SET RBAL=$PIECE(^ABPACHKS(DA(2),"I",DA(1),"C",DA,0),"^",4)
+72 SET DR="4///"_DUZ_";5///NOW;8///"_+RBAL_";11///N"
DO ^DIE
+73 ;-------------------------------------------------------------
End DoDot:4
WRITE !
QUIT
+74 KILL DIC,DIE,DR,DA
+75 SET ABPADFN(3)=+Y
SET DA(2)=ABPADFN(1)
SET DA(1)=ABPADFN(2)
SET DA=ABPADFN(3)
+76 SET DIE="^ABPACHKS("_DA(2)_",""I"","_DA(1)_",""C"","
SET DIE("NO^")=""
+77 SET DR=".01;3;"
IF $DATA(ABPAOPT(1))=11
IF ABPAOPT(1)="Y"
SET DR=DR_"14;"
+78 SET DR=DR_"1///NOW;2///"_DUZ_";6///N;7///0"
WRITE !
DO ^DIE
+79 IF $DATA(DA)=0
QUIT
SET RBAL=$PIECE(^ABPACHKS(DA(2),"I",DA(1),"C",DA,0),"^",4)
+80 SET RBAL=RBAL-$PIECE(^ABPACHKS(DA(2),"I",DA(1),"C",DA,0),"^",8)
+81 SET DR="4///"_DUZ_";5///NOW;8///"_+RBAL_";11///N"
DO ^DIE
End DoDot:3
IF 'GOTCHECK
IF ABPACHK=""
SET ACCTPT=ABPACAP
QUIT
End DoDot:2
IF NOINS
SET LOGDT=DT
DO HEAD
QUIT
End DoDot:1
IF NOACCT
QUIT
+82 QUIT
+83 ;--------------------------------------------------------------------
MAIN ;MAIN ROUTINE DRIVER PROCEDURE
+1 FOR ABPAJ=0:0
DO CLEAR
SET LOGDT=DT
DO HEAD
SET NOACCT=0
DO GETCHK
IF NOACCT
QUIT
+2 DO CLEAR
KILL I
+3 QUIT
