- 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 ;
