- 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
