- ACHSCHK1 ; IHS/ITSC/PMF - PRINT 638 CHECKS (2/2) ; [ 10/16/2001 8:16 AM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- ;
- RETURN ;EP - From option. Enter check return date.
- S ACHSADJ=""
- R1 ;
- D ^ACHSUSC
- G K:'$D(ACHSDIEN)
- I '$$DOC^ACHS(2,3) W *7,!!,"NO CHECK HAS BEEN PRINTED FOR THIS DOCUMENT." G R1
- S ACHS=$P($G(^DD(9002080.01,51,0)),U),DA=ACHSDIEN,DA(1)=DUZ(2)
- W !?18-$L(ACHS),ACHS,": ",$$VAL^XBDIQ1(9002080.01,.DA,51)
- S ACHS=$P($G(^DD(9002080.01,52,0)),U)
- W !?18-$L(ACHS),ACHS,": ",$$VAL^XBDIQ1(9002080.01,.DA,52)
- S DA=ACHSDIEN,DIE="^ACHSF("_DUZ(2)_",""D"",",DR="53",DR(1)="100;",DR(1,9002080)="100;",DR(2,9002080.01)="53"
- D ^DIE
- W !
- K ;
- K ACHSDIEN,DA,DIC,DIE,DR
- Q
- ;
- AMT ;EP - Written amount. Expected input is output of COMMA^%DTC with X3=1.
- S ACHSX="",ACHSHUNS=$P(X,"."),ACHSTHOU=$S(X[",":$E(1000+$P(X,","),2,4),1:"000")
- I ACHSHUNS["," S ACHSHUNS=$P(ACHSHUNS,",",2)
- S ACHSHUNS=$E(1000+ACHSHUNS,2,4),ACHSCENT=$E(100+$P(X,".",2),2,3)
- G AMTH:'(+ACHSTHOU)
- I +$E(ACHSTHOU) S ACHSX=$P($P($T(@1),";;",2),U,+$E(ACHSTHOU))_" HUNDRED "
- I +$E(ACHSTHOU,2)>1 S ACHSX=ACHSX_$P($P($T(@11),";;",2),U,$E(ACHSTHOU,2))_"-"_$P($P($T(@1),";;",2),U,$E(ACHSTHOU,3))
- I +$E(ACHSTHOU,2)=1 S ACHSX=ACHSX_$P($P($T(@10),";;",2),U,+$E(ACHSTHOU,2,3)-9)
- I +$E(ACHSTHOU,2)=0 S ACHSX=ACHSX_$P($P($T(@1),";;",2),U,+$E(ACHSTHOU,3)) I +$E(ACHSTHOU,3)=0 S ACHSX=$E(ACHSX,1,$L(ACHSX)-1)
- I +ACHSTHOU>0 S ACHSX=ACHSX_" THOUSAND "
- AMTH ;
- G ADJST:'(+ACHSHUNS)
- I +$E(ACHSHUNS) S ACHSX=ACHSX_$P($P($T(@1),";;",2),U,+$E(ACHSHUNS))_" HUNDRED "
- I +$E(ACHSHUNS,2)>1 S ACHSX=ACHSX_$P($P($T(@11),";;",2),U,$E(ACHSHUNS,2)) I $E(ACHSHUNS,3)>0 S ACHSX=ACHSX_"-"_$P($P($T(@1),";;",2),U,$E(ACHSHUNS,3))
- I +$E(ACHSHUNS,2)=1 S ACHSX=ACHSX_$P($P($T(@10),";;",2),U,+$E(ACHSHUNS,2,3)-9)
- ADJST ;
- I +$E(ACHSHUNS,2)=0 S ACHSX=ACHSX_$P($P($T(@1),";;",2),U,+$E(ACHSHUNS,3)) I +$E(ACHSHUNS,3)=0 S ACHSX=$E(ACHSX,1,$L(ACHSX)-1)
- AMTC ;
- I ACHSX="" S ACHSX="NO"
- S ACHSX=ACHSX_" DOLLARS AND "
- I +$E(ACHSCENT)>1 S ACHSX=ACHSX_$P($P($T(@11),";;",2),U,+$E(ACHSCENT)) I +$E(ACHSCENT,2)>0 S ACHSX=ACHSX_"-"_$P($P($T(@1),";;",2),U,+$E(ACHSCENT,2))
- I +$E(ACHSCENT)=1 S ACHSX=ACHSX_$P($P($T(@10),";;",2),U,+$E(ACHSCENT,1,2)-9)
- I +ACHSCENT<10 S ACHSX=ACHSX_$P($P($T(@1),";;",2),U,+$E(ACHSCENT,2))
- I +ACHSCENT=0 S ACHSX=ACHSX_"NO"
- S ACHSX=ACHSX_" CENTS"
- F Q:ACHSX'[" " S ACHSX=$P(ACHSX," ")_$E($P(ACHSX," ",2),2,99)
- S X=ACHSX
- K ACHSCENT,ACHSHUNS,ACHSTHOU,ACHSX
- Q
- ;
- 1 ;;ONE^TWO^THREE^FOUR^FIVE^SIX^SEVEN^EIGHT^NINE
- 10 ;;TEN^ELEVEN^TWELVE^THIRTEEN^FOURTEEN^FIFTEEN^SIXTEEN^SEVENTEEN^EIGHTEEN^NINETEEN
- 11 ;;^TWENTY^THIRTY^FORTY^FIFTY^SIXTY^SEVENTY^EIGHTY^NINETY^
- ;
- TAMT ;
- F X=0.88,3,5.03,23,44.5,150,234.22,1122.22,2910,44332,345678.21,999999.99 S X3=1 D COMMA^%DTC W X,! D AMT W X,! H 1
- Q
- ;
- ACHSCHK1 ; IHS/ITSC/PMF - PRINT 638 CHECKS (2/2) ; [ 10/16/2001 8:16 AM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- +2 ;
- RETURN ;EP - From option. Enter check return date.
- +1 SET ACHSADJ=""
- R1 ;
- +1 DO ^ACHSUSC
- +2 IF '$DATA(ACHSDIEN)
- GOTO K
- +3 IF '$$DOC^ACHS(2,3)
- WRITE *7,!!,"NO CHECK HAS BEEN PRINTED FOR THIS DOCUMENT."
- GOTO R1
- +4 SET ACHS=$PIECE($GET(^DD(9002080.01,51,0)),U)
- SET DA=ACHSDIEN
- SET DA(1)=DUZ(2)
- +5 WRITE !?18-$LENGTH(ACHS),ACHS,": ",$$VAL^XBDIQ1(9002080.01,.DA,51)
- +6 SET ACHS=$PIECE($GET(^DD(9002080.01,52,0)),U)
- +7 WRITE !?18-$LENGTH(ACHS),ACHS,": ",$$VAL^XBDIQ1(9002080.01,.DA,52)
- +8 SET DA=ACHSDIEN
- SET DIE="^ACHSF("_DUZ(2)_",""D"","
- SET DR="53"
- SET DR(1)="100;"
- SET DR(1,9002080)="100;"
- SET DR(2,9002080.01)="53"
- +9 DO ^DIE
- +10 WRITE !
- K ;
- +1 KILL ACHSDIEN,DA,DIC,DIE,DR
- +2 QUIT
- +3 ;
- AMT ;EP - Written amount. Expected input is output of COMMA^%DTC with X3=1.
- +1 SET ACHSX=""
- SET ACHSHUNS=$PIECE(X,".")
- SET ACHSTHOU=$SELECT(X[",":$EXTRACT(1000+$PIECE(X,","),2,4),1:"000")
- +2 IF ACHSHUNS[","
- SET ACHSHUNS=$PIECE(ACHSHUNS,",",2)
- +3 SET ACHSHUNS=$EXTRACT(1000+ACHSHUNS,2,4)
- SET ACHSCENT=$EXTRACT(100+$PIECE(X,".",2),2,3)
- +4 IF '(+ACHSTHOU)
- GOTO AMTH
- +5 IF +$EXTRACT(ACHSTHOU)
- SET ACHSX=$PIECE($PIECE($TEXT(@1),";;",2),U,+$EXTRACT(ACHSTHOU))_" HUNDRED "
- +6 IF +$EXTRACT(ACHSTHOU,2)>1
- SET ACHSX=ACHSX_$PIECE($PIECE($TEXT(@11),";;",2),U,$EXTRACT(ACHSTHOU,2))_"-"_$PIECE($PIECE($TEXT(@1),";;",2),U,$EXTRACT(ACHSTHOU,3))
- +7 IF +$EXTRACT(ACHSTHOU,2)=1
- SET ACHSX=ACHSX_$PIECE($PIECE($TEXT(@10),";;",2),U,+$EXTRACT(ACHSTHOU,2,3)-9)
- +8 IF +$EXTRACT(ACHSTHOU,2)=0
- SET ACHSX=ACHSX_$PIECE($PIECE($TEXT(@1),";;",2),U,+$EXTRACT(ACHSTHOU,3))
- IF +$EXTRACT(ACHSTHOU,3)=0
- SET ACHSX=$EXTRACT(ACHSX,1,$LENGTH(ACHSX)-1)
- +9 IF +ACHSTHOU>0
- SET ACHSX=ACHSX_" THOUSAND "
- AMTH ;
- +1 IF '(+ACHSHUNS)
- GOTO ADJST
- +2 IF +$EXTRACT(ACHSHUNS)
- SET ACHSX=ACHSX_$PIECE($PIECE($TEXT(@1),";;",2),U,+$EXTRACT(ACHSHUNS))_" HUNDRED "
- +3 IF +$EXTRACT(ACHSHUNS,2)>1
- SET ACHSX=ACHSX_$PIECE($PIECE($TEXT(@11),";;",2),U,$EXTRACT(ACHSHUNS,2))
- IF $EXTRACT(ACHSHUNS,3)>0
- SET ACHSX=ACHSX_"-"_$PIECE($PIECE($TEXT(@1),";;",2),U,$EXTRACT(ACHSHUNS,3))
- +4 IF +$EXTRACT(ACHSHUNS,2)=1
- SET ACHSX=ACHSX_$PIECE($PIECE($TEXT(@10),";;",2),U,+$EXTRACT(ACHSHUNS,2,3)-9)
- ADJST ;
- +1 IF +$EXTRACT(ACHSHUNS,2)=0
- SET ACHSX=ACHSX_$PIECE($PIECE($TEXT(@1),";;",2),U,+$EXTRACT(ACHSHUNS,3))
- IF +$EXTRACT(ACHSHUNS,3)=0
- SET ACHSX=$EXTRACT(ACHSX,1,$LENGTH(ACHSX)-1)
- AMTC ;
- +1 IF ACHSX=""
- SET ACHSX="NO"
- +2 SET ACHSX=ACHSX_" DOLLARS AND "
- +3 IF +$EXTRACT(ACHSCENT)>1
- SET ACHSX=ACHSX_$PIECE($PIECE($TEXT(@11),";;",2),U,+$EXTRACT(ACHSCENT))
- IF +$EXTRACT(ACHSCENT,2)>0
- SET ACHSX=ACHSX_"-"_$PIECE($PIECE($TEXT(@1),";;",2),U,+$EXTRACT(ACHSCENT,2))
- +4 IF +$EXTRACT(ACHSCENT)=1
- SET ACHSX=ACHSX_$PIECE($PIECE($TEXT(@10),";;",2),U,+$EXTRACT(ACHSCENT,1,2)-9)
- +5 IF +ACHSCENT<10
- SET ACHSX=ACHSX_$PIECE($PIECE($TEXT(@1),";;",2),U,+$EXTRACT(ACHSCENT,2))
- +6 IF +ACHSCENT=0
- SET ACHSX=ACHSX_"NO"
- +7 SET ACHSX=ACHSX_" CENTS"
- +8 FOR
- IF ACHSX'[" "
- QUIT
- SET ACHSX=$PIECE(ACHSX," ")_$EXTRACT($PIECE(ACHSX," ",2),2,99)
- +9 SET X=ACHSX
- +10 KILL ACHSCENT,ACHSHUNS,ACHSTHOU,ACHSX
- +11 QUIT
- +12 ;
- 1 ;;ONE^TWO^THREE^FOUR^FIVE^SIX^SEVEN^EIGHT^NINE
- 10 ;;TEN^ELEVEN^TWELVE^THIRTEEN^FOURTEEN^FIFTEEN^SIXTEEN^SEVENTEEN^EIGHTEEN^NINETEEN
- 11 ;;^TWENTY^THIRTY^FORTY^FIFTY^SIXTY^SEVENTY^EIGHTY^NINETY^
- +1 ;
- TAMT ;
- +1 FOR X=0.88,3,5.03,23,44.5,150,234.22,1122.22,2910,44332,345678.21,999999.99
- SET X3=1
- DO COMMA^%DTC
- WRITE X,!
- DO AMT
- WRITE X,!
- HANG 1
- +2 QUIT
- +3 ;
