ABPAPD2B ;PVT-INS PYMT ENTRY CONTINUED; [ 07/10/91 12:02 PM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
DIC1 K DIC,DIE,DR,DA,%DT S DA(1)=ABPATDFN
I $D(^ABPVAO(DA(1),"P",0))=0 D
.S ^ABPVAO(DA(1),"P",0)="^9002270.22DA^^0"
S DIC="^ABPVAO("_DA(1)_",""P"",",DIC(0)="LXZ"
S X=ABPABDT D ^DIC
I +$P(Y,U,3)=0 D G @ABPACONT
.W !!?5,*7,"*** PAYMENT ALREADY ON FILE FOR THIS BATCH DATE ***"
.W !!,"DO YOU WANT TO CREATE ANOTHER ENTRY" S %=2
.K ABPACONT D YN^DICN
.I +%'=1 L ^ABPVAO(ABPATDFN) S ABPACONT="^ABPAPD1" Q
.S X=""""_ABPABDT_"""" D ^DIC S ABPACONT="DIE1"
DIE1 K DIC,DIE,DR,DA S ABPADDFN=+Y,DA(1)=ABPATDFN,DA=ABPADDFN
S DIE="^ABPVAO("_DA(1)_",""P"",",DR="1///T;1.01///"_DUZ
S DR=DR_";1.03///T;1.05///"_DUZ D ^DIE
;S:ABPAOPT(1)="Y" DR=DR_";.03" W ! D ^DIE
F I=0:0 D Q:(GOTCHECK)!(('GOTCHECK)&((Y="")!(Y["^"))) W *7," ??"
.D MAIN^ABPACKLK I GOTCHECK D
..S DR=".05///"_ABPACHK("NUM") D ^DIE D ^ABPAPD2C
..S X=ABPACHK("RAMT") D COMMA^%DTC S Y=X
..S X="*** Check #"_ABPACHK("NUM")_" has a remaining balance of $"
..S X=X_Y_"***" W !?(40-($L(X)/2)),X Q
I 'GOTCHECK I Y'="" D G ^ABPAPD1
.W *7,!!?10,"NO CHECK SELECTED -- CANCELLING THIS ENTRY..." H 2
.S DIK="^ABPVAO("_DA(1)_",""P""," D ^DIK
.L ^ABPVAO(ABPATDFN)
W ! I $D(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",0))=0 D
.S ^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",0)="^9002270.223A^^0"
DIR K DIR,X,Y,ABPA("ANS")
S DIR(0)="FO^2:15",DIR("A")=" PAYMENT AMOUNT"
S DIR("?",1)="Enter a dollar amount between .01 and 999999. You may "
S DIR("?",1)=DIR("?",1)_"use the 'fast entry'"
S DIR("?",2)="method if you wish by following the dollar amount with "
S DIR("?",2)=DIR("?",2)_"the TYPE OF PAYMENT"
S DIR("?",3)="(1:Standard 2:Deductible 3:Non-covered 4:Penalty) and "
S DIR("?",3)=DIR("?",3)_"CLAIM ASSIGNMENT"
S DIR("?",4)="separated by commas. Entering 20.13,2,"_ABPACCNT
S DIR("?",4)=DIR("?",4)_" for example, creates a $20.13"
S DIR("?",5)="transaction assigned to the last claim currently "
S DIR("?",5)=DIR("?",5)_"displayed.",DIR("?")=" " D ^DIR
S ABPA("ANS")=Y
I +Y=0 I $E(Y)'="""" K DA S Y=-1,DA(1)=ABPATDFN,DA=ABPADDFN G NOENT
K DIC,DIE,DA,DR S DA(1)=ABPATDFN,DA=ABPADDFN,X=$P(ABPA("ANS"),",")
S DIC="^ABPVAO("_DA(1)_",""P"","_DA_",""A"",",DIC(0)="LQ" D ^DIC
NOENT I +Y<0&(+$P(^ABPVAO(DA(1),"P",DA,"A",0),"^",4)'>0) D G ^ABPAPD1
.W *7,!!?10,"NO PAYMENTS ENTERED -- CANCELLING THIS ENTRY..." H 2
.S DIK="^ABPVAO("_DA(1)_",""P""," D ^DIK
.L ^ABPVAO(ABPATDFN)
G:+Y<0 DIE3 I +$P(Y,U,3)=0 D G DIR
.W *7,!!?5,"You have already made an entry of this amount. If you"
.W !?5,"need to make another entry of the same amount for a"
.W !?5,"different type, please put quotes around the amount."
.W !!?20,"i.e. ""48.23"""
DIE2 K DIC,DIE,DA,DR S DA=+Y,DA(1)=ABPADDFN,DA(2)=ABPATDFN
S DIE="^ABPVAO("_DA(2)_",""P"","_DA(1)_",""A"",",DIE("NO^")=""
S DIE("W")="W !,$J($P(DQ(DQ),""^""),16),"": """
S DR="1//STANDARD" I $P(ABPA("ANS"),",",2)]"" D
.Q:+$E($P(ABPA("ANS"),",",2))<1!(+$E($P(ABPA("ANS"),",",2))>4)
.D @(+$E($P(ABPA("ANS"),",",2)))
D ^DIE S ABPACOD=X K DIR I ABPACCNT=1 D G DIR
.S DR="2///"_ABPA("C",1) D ^DIE
S X=+$P(ABPA("ANS"),",",3) I X'>0 D
.S DIR(0)="NO^1:"_ABPACCNT,DIR("A")="CLAIM ASSIGNMENT" D ^DIR
G:'X&(ABPACOD'="P") DIR I 'X D G DIR
.W *7,!?5,"<<< PENALTYS MUST BE APPLIED - TRANSACTION DELETED >>>"
.K DIK S DIK="^ABPVAO("_DA(2)_",""P"","_DA(1)_",""A""," D ^DIK
G:$D(ABPA("C",X))'=1 DIR S DR="2///"_ABPA("C",X) D ^DIE G DIR
DIE3 K DIC,DIE,DA,DR S DA=ABPADDFN,DA(1)=ABPATDFN
S DIE="^ABPVAO("_DA(1)_",""P"",",DR="4///N;5///"_DT D ^DIE
CONT G ^ABPAPD3
1 S DR="1///S" Q
2 S DR="1///D" Q
3 S DR="1///N" Q
4 S DR="1///P" Q
ABPAPD2B ;PVT-INS PYMT ENTRY CONTINUED; [ 07/10/91 12:02 PM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
DIC1 KILL DIC,DIE,DR,DA,%DT
SET DA(1)=ABPATDFN
+1 IF $DATA(^ABPVAO(DA(1),"P",0))=0
Begin DoDot:1
+2 SET ^ABPVAO(DA(1),"P",0)="^9002270.22DA^^0"
End DoDot:1
+3 SET DIC="^ABPVAO("_DA(1)_",""P"","
SET DIC(0)="LXZ"
+4 SET X=ABPABDT
DO ^DIC
+5 IF +$PIECE(Y,U,3)=0
Begin DoDot:1
+6 WRITE !!?5,*7,"*** PAYMENT ALREADY ON FILE FOR THIS BATCH DATE ***"
+7 WRITE !!,"DO YOU WANT TO CREATE ANOTHER ENTRY"
SET %=2
+8 KILL ABPACONT
DO YN^DICN
+9 IF +%'=1
LOCK ^ABPVAO(ABPATDFN)
SET ABPACONT="^ABPAPD1"
QUIT
+10 SET X=""""_ABPABDT_""""
DO ^DIC
SET ABPACONT="DIE1"
End DoDot:1
GOTO @ABPACONT
DIE1 KILL DIC,DIE,DR,DA
SET ABPADDFN=+Y
SET DA(1)=ABPATDFN
SET DA=ABPADDFN
+1 SET DIE="^ABPVAO("_DA(1)_",""P"","
SET DR="1///T;1.01///"_DUZ
+2 SET DR=DR_";1.03///T;1.05///"_DUZ
DO ^DIE
+3 ;S:ABPAOPT(1)="Y" DR=DR_";.03" W ! D ^DIE
+4 FOR I=0:0
Begin DoDot:1
+5 DO MAIN^ABPACKLK
IF GOTCHECK
Begin DoDot:2
+6 SET DR=".05///"_ABPACHK("NUM")
DO ^DIE
DO ^ABPAPD2C
+7 SET X=ABPACHK("RAMT")
DO COMMA^%DTC
SET Y=X
+8 SET X="*** Check #"_ABPACHK("NUM")_" has a remaining balance of $"
+9 SET X=X_Y_"***"
WRITE !?(40-($LENGTH(X)/2)),X
QUIT
End DoDot:2
End DoDot:1
IF (GOTCHECK)!(('GOTCHECK)&((Y="")!(Y["^")))
QUIT
WRITE *7," ??"
+10 IF 'GOTCHECK
IF Y'=""
Begin DoDot:1
+11 WRITE *7,!!?10,"NO CHECK SELECTED -- CANCELLING THIS ENTRY..."
HANG 2
+12 SET DIK="^ABPVAO("_DA(1)_",""P"","
DO ^DIK
+13 LOCK ^ABPVAO(ABPATDFN)
End DoDot:1
GOTO ^ABPAPD1
+14 WRITE !
IF $DATA(^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",0))=0
Begin DoDot:1
+15 SET ^ABPVAO(ABPATDFN,"P",ABPADDFN,"A",0)="^9002270.223A^^0"
End DoDot:1
DIR KILL DIR,X,Y,ABPA("ANS")
+1 SET DIR(0)="FO^2:15"
SET DIR("A")=" PAYMENT AMOUNT"
+2 SET DIR("?",1)="Enter a dollar amount between .01 and 999999. You may "
+3 SET DIR("?",1)=DIR("?",1)_"use the 'fast entry'"
+4 SET DIR("?",2)="method if you wish by following the dollar amount with "
+5 SET DIR("?",2)=DIR("?",2)_"the TYPE OF PAYMENT"
+6 SET DIR("?",3)="(1:Standard 2:Deductible 3:Non-covered 4:Penalty) and "
+7 SET DIR("?",3)=DIR("?",3)_"CLAIM ASSIGNMENT"
+8 SET DIR("?",4)="separated by commas. Entering 20.13,2,"_ABPACCNT
+9 SET DIR("?",4)=DIR("?",4)_" for example, creates a $20.13"
+10 SET DIR("?",5)="transaction assigned to the last claim currently "
+11 SET DIR("?",5)=DIR("?",5)_"displayed."
SET DIR("?")=" "
DO ^DIR
+12 SET ABPA("ANS")=Y
+13 IF +Y=0
IF $EXTRACT(Y)'=""""
KILL DA
SET Y=-1
SET DA(1)=ABPATDFN
SET DA=ABPADDFN
GOTO NOENT
+14 KILL DIC,DIE,DA,DR
SET DA(1)=ABPATDFN
SET DA=ABPADDFN
SET X=$PIECE(ABPA("ANS"),",")
+15 SET DIC="^ABPVAO("_DA(1)_",""P"","_DA_",""A"","
SET DIC(0)="LQ"
DO ^DIC
NOENT IF +Y<0&(+$PIECE(^ABPVAO(DA(1),"P",DA,"A",0),"^",4)'>0)
Begin DoDot:1
+1 WRITE *7,!!?10,"NO PAYMENTS ENTERED -- CANCELLING THIS ENTRY..."
HANG 2
+2 SET DIK="^ABPVAO("_DA(1)_",""P"","
DO ^DIK
+3 LOCK ^ABPVAO(ABPATDFN)
End DoDot:1
GOTO ^ABPAPD1
+4 IF +Y<0
GOTO DIE3
IF +$PIECE(Y,U,3)=0
Begin DoDot:1
+5 WRITE *7,!!?5,"You have already made an entry of this amount. If you"
+6 WRITE !?5,"need to make another entry of the same amount for a"
+7 WRITE !?5,"different type, please put quotes around the amount."
+8 WRITE !!?20,"i.e. ""48.23"""
End DoDot:1
GOTO DIR
DIE2 KILL DIC,DIE,DA,DR
SET DA=+Y
SET DA(1)=ABPADDFN
SET DA(2)=ABPATDFN
+1 SET DIE="^ABPVAO("_DA(2)_",""P"","_DA(1)_",""A"","
SET DIE("NO^")=""
+2 SET DIE("W")="W !,$J($P(DQ(DQ),""^""),16),"": """
+3 SET DR="1//STANDARD"
IF $PIECE(ABPA("ANS"),",",2)]""
Begin DoDot:1
+4 IF +$EXTRACT($PIECE(ABPA("ANS"),",",2))<1!(+$EXTRACT($PIECE(ABPA("ANS"),",",2))>4)
QUIT
+5 DO @(+$EXTRACT($PIECE(ABPA("ANS"),",",2)))
End DoDot:1
+6 DO ^DIE
SET ABPACOD=X
KILL DIR
IF ABPACCNT=1
Begin DoDot:1
+7 SET DR="2///"_ABPA("C",1)
DO ^DIE
End DoDot:1
GOTO DIR
+8 SET X=+$PIECE(ABPA("ANS"),",",3)
IF X'>0
Begin DoDot:1
+9 SET DIR(0)="NO^1:"_ABPACCNT
SET DIR("A")="CLAIM ASSIGNMENT"
DO ^DIR
End DoDot:1
+10 IF 'X&(ABPACOD'="P")
GOTO DIR
IF 'X
Begin DoDot:1
+11 WRITE *7,!?5,"<<< PENALTYS MUST BE APPLIED - TRANSACTION DELETED >>>"
+12 KILL DIK
SET DIK="^ABPVAO("_DA(2)_",""P"","_DA(1)_",""A"","
DO ^DIK
End DoDot:1
GOTO DIR
+13 IF $DATA(ABPA("C",X))'=1
GOTO DIR
SET DR="2///"_ABPA("C",X)
DO ^DIE
GOTO DIR
DIE3 KILL DIC,DIE,DA,DR
SET DA=ABPADDFN
SET DA(1)=ABPATDFN
+1 SET DIE="^ABPVAO("_DA(1)_",""P"","
SET DR="4///N;5///"_DT
DO ^DIE
CONT GOTO ^ABPAPD3
1 SET DR="1///S"
QUIT
2 SET DR="1///D"
QUIT
3 SET DR="1///N"
QUIT
4 SET DR="1///P"
QUIT
