ACHSPAA.m

ACHSPAA ; IHS/ITSC/PMF - DOCUMENT PAYMENT - ENTER/EDIT AMOUNT ;  [ 10/16/2001   8:16 AM ]

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 ;

A1 ;

 W !!,"IHS Cost: "

 I ACHSVAMT S X=ACHSVAMT,X2=2 D FMT^ACHS W "//"

 ;

 D READ^ACHSFU

 I $D(DUOUT)!$D(DTOUT) D END Q

 I Y?1"?".E W !,"  Enter The Dollar Amount Requested for Payment (e.g. 27.50)" G A1

 I Y="" D END:ACHSVAMT W *7,"  Must Have Amount" G A1

 S:$E(Y,1)="$" Y=$E(Y,2,999)

 F I=1:1 S F=$F(Y,",") Q:'F  S Y=$E(Y,1,F-2)_$E(Y,F,99)

 I '(Y?1N.N1"."2N!(Y?1N.N))!($L(Y)>10) W *7,"  ??" G A1

 S X=Y,X2=2

 W "  ("

 D FMT^ACHS

 W ")"

 S H=$J(Y,1,2),T=ACHSPAMT-ACHSVAMT+H

 I T'>ACHSTAO G A9

 W !!,"Obligated Amount"

 S X=ACHSTAO,X2=2,X3=20

 D FMT^ACHS

 W !,"Current Charge Total"

 S X=T,X2=2,X3=16

 D FMT^ACHS

 W !?26,"---------",!,"Exceeded Amount         "

 S X=T-ACHSTAO,X2=2,X3=12

 D FMT^ACHS

 I ACHSOPAY W !!,"Max Overpmt Allowed" S X=$P(ACHSOPAY,U,2),X2=2,X3=9 D FMT^ACHS

 I 'ACHSOPAY W !!,*7,"  The Charge Total May NOT Exceed The Obligated Amount.",!! G A1

 S D=T-ACHSTAO

 I D>$P(ACHSOPAY,U,2) W *7,!!,"  You May NOT Exceed This Amount" G A1

A2 ;

 G A1:'$$DIR^XBDIR("Y","Ok ","NO","","  Do You Wish To Overpay On This Document.","",2)

 I $D(DTOUT) D END Q

 G A1:$D(DUOUT)

A9 ;

 S ACHSIPA=ACHSIPA-ACHSVAMT+H,ACHSPAMT=T,ACHSVAMT=H

END ;

 Q

 ;

ACHSPAA   ; IHS/ITSC/PMF - DOCUMENT PAYMENT - ENTER/EDIT AMOUNT ;  [ 10/16/2001   8:16 AM ]

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001

 +2       ;

A1        ;

 +1        WRITE !!,"IHS Cost: "

 +2        IF ACHSVAMT

               SET X=ACHSVAMT

               SET X2=2

               DO FMT^ACHS

               WRITE "//"

 +3       ;

 +4        DO READ^ACHSFU

 +5        IF $DATA(DUOUT)!$DATA(DTOUT)

               DO END

               QUIT 

 +6        IF Y?1"?".E

               WRITE !,"  Enter The Dollar Amount Requested for Payment (e.g. 27.50)"

               GOTO A1

 +7        IF Y=""

               IF ACHSVAMT

                   DO END

               WRITE *7,"  Must Have Amount"

               GOTO A1

 +8        IF $EXTRACT(Y,1)="$"

               SET Y=$EXTRACT(Y,2,999)

 +9        FOR I=1:1

               SET F=$FIND(Y,",")

               IF 'F

                   QUIT 

               SET Y=$EXTRACT(Y,1,F-2)_$EXTRACT(Y,F,99)

 +10       IF '(Y?1N.N1"."2N!(Y?1N.N))!($LENGTH(Y)>10)

               WRITE *7,"  ??"

               GOTO A1

 +11       SET X=Y

           SET X2=2

 +12       WRITE "  ("

 +13       DO FMT^ACHS

 +14       WRITE ")"

 +15       SET H=$JUSTIFY(Y,1,2)

           SET T=ACHSPAMT-ACHSVAMT+H

 +16       IF T'>ACHSTAO

               GOTO A9

 +17       WRITE !!,"Obligated Amount"

 +18       SET X=ACHSTAO

           SET X2=2

           SET X3=20

 +19       DO FMT^ACHS

 +20       WRITE !,"Current Charge Total"

 +21       SET X=T

           SET X2=2

           SET X3=16

 +22       DO FMT^ACHS

 +23       WRITE !?26,"---------",!,"Exceeded Amount         "

 +24       SET X=T-ACHSTAO

           SET X2=2

           SET X3=12

 +25       DO FMT^ACHS

 +26       IF ACHSOPAY

               WRITE !!,"Max Overpmt Allowed"

               SET X=$PIECE(ACHSOPAY,U,2)

               SET X2=2

               SET X3=9

               DO FMT^ACHS

 +27       IF 'ACHSOPAY

               WRITE !!,*7,"  The Charge Total May NOT Exceed The Obligated Amount.",!!

               GOTO A1

 +28       SET D=T-ACHSTAO

 +29       IF D>$PIECE(ACHSOPAY,U,2)

               WRITE *7,!!,"  You May NOT Exceed This Amount"

               GOTO A1

A2        ;

 +1        IF '$$DIR^XBDIR("Y","Ok ","NO","","  Do You Wish To Overpay On This Document.","",2)

               GOTO A1

 +2        IF $DATA(DTOUT)

               DO END

               QUIT 

 +3        IF $DATA(DUOUT)

               GOTO A1

A9        ;

 +1        SET ACHSIPA=ACHSIPA-ACHSVAMT+H

           SET ACHSPAMT=T

           SET ACHSVAMT=H

END       ;

 +1        QUIT 

 +2       ;