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 ;
