ABPAPD2B.m

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