RCDPCSA ;UNY/RGB-CROSS-SERVICING STATUS FIX ;03/15/14 3:34 PM
;;4.5;Accounts Receivable;**325,336,343**;Mar 20, 1995;Build 59
;;Per VA Directive 6402, this routine should not be modified.
;OPTION: RCDP TCSP FLAG CONTROL
;
;PRCA*4.5*336 When setting bills to cross service date
; ensure the TCSP address node ^PRCA(430,ien,16)
; is established
;PRCA*4.5*343 Moved Name/taxid lookup into routine since they
; were moved from previous calls into RCTCSPD.
;
A S U="^" S SITE=+$$SITE^VASITE
B K DIR S DIR(0)="SO^1:Set cross-service flag on BILL;2:Clear cross-service flag on BILL;3:Clear cross-service flag on DEBTOR (AND ALL BILLS);4:Set cross-service flag on DEBTOR;5:Fully re-establish debtor/bill as cross-serviced"
S DIR("?")="Enter an option number 1 to 5."
S DIR("A")="Select Number"
D ^DIR
G EXIT:$D(DIRUT)
S PRCAOPT=+Y
;
C ;select bill
; returns -1 for timeout or ^, 0 for no selection, or ien of bill
K %,%Y,C,DIC,DIR,DIE,DTOUT,DUOUT,X,Y
K RCY,DIR,DIRUT
W ! S DIC="^PRCA(430,",DIC(0)="QEAM",DIC("A")="Select BILL: "
; special lookup on input
S RCBEFLUP=1
D ^DIC
I $G(DUOUT)!$G(DTOUT) G B
I Y<0 G B
S RCBILLDA=+Y
;Disp last 4 soc#
C1 I '$D(^PRCA(430,"TCSP",RCBILLDA)),PRCAOPT=2 W !,"*** BILL NOT CROSS SERVICED ***" G C
I $P($G(^PRCA(430,RCBILLDA,0)),U,8)'=16 W !,"*** BILL NOT ACTIVE ***" G C
S RCDEBTOR=$P($G(^PRCA(430,RCBILLDA,0)),U,9) I 'RCDEBTOR W !," < *** debtor not found on bill *** >" G C
S RCDEBTV=$P($G(^RCD(340,RCDEBTOR,0)),U) I 'RCDEBTV W !," < *** debtor on bill not found *** >" G C
I RCDEBTV'["DPT(" W !," < *** debtor must be a veteran *** >" G C
I '$D(^RCD(340,"TCSP",RCDEBTOR)),"245"'[PRCAOPT W !," <debtor not flagged as CS *** >" G C
S RCDPT=+RCDEBTV,RC0=$G(^DPT(RCDPT,0)) I RC0="" W !," < *** debtor info not found *** >" G C
W ?60,$E($P(RC0,U,9),6,9)
D @PRCAOPT
G C
1 ;option 1
I $D(^PRCA(430,"TCSP",RCBILLDA)) W !,"*** BILL ALREADY CROSS-SERVICED ***" Q
S DIR(0)="D",DIR("A")="Enter Cross-Sevice Date" D ^DIR K DIR
I $D(DIRUT)!($D(DUOUT)) Q
S RCDATE=Y
S DIR(0)="YA",DIR("A")="File CS Bill Change (Y/N): ",DIR("B")="N",DIR("?")="Enter (Y)es to file or (N)o to skip filing"
D ^DIR K DIR I Y=0!$G(DIRUT) W " < Bill Not Updated >" Q
S RCDAS=RCBILLDA_",",PRCAR(430,RCDAS,151)=RCDATE D FILE^DIE("EK","PRCAR","PRCAERR") I $D(PRCAERR) W " <",$G(PRCAERR("DIERR",1,"TEXT",1)),">" K PRCAERR G 1
D SET16 ;PRCA*4.5*336
W " <DONE>"
Q
2 ;option 2
I '$D(^PRCA(430,"TCSP",RCBILLDA)) W !,"*** BILL NOT CROSS SERVICED ***" Q
S DIR(0)="YA",DIR("A")="File CS Bill Flag Removal (Y/N): ",DIR("B")="N",DIR("?")="Enter (Y)es to file or (N)o to skip filing"
D ^DIR K DIR I Y=0!$G(DIRUT) W " <Bill Not Updated" Q
K ^PRCA(430,RCBILLDA,16)
S DA=RCBILLDA,DIE="^PRCA(430,",DR="151////@" D ^DIE W " <DONE>" ;PRCA*4.5*336
Q
3 ;option 3
S DIR(0)="YA",DIR("A")="File CS Debtor/Bills Flag Removal (Y/N): ",DIR("B")="N",DIR("?")="Enter (Y)es to file or (N)o to skip filing"
D ^DIR I Y=0!$G(DIRUT) W " <Bill Not Updated" Q
S DA=RCDEBTOR,DIE="^RCD(340,",DR="7.05////@" D ^DIE W " <DONE>"
S PRCAIEN=0
F S PRCAIEN=$O(^PRCA(430,"C",RCDEBTOR,PRCAIEN)) Q:'PRCAIEN D
. I '$D(^PRCA(430,"TCSP",PRCAIEN)) Q
. S DA=PRCAIEN,DIE="^PRCA(430,",DR="151////@" D ^DIE ;PRCA*4.5*336
. K ^PRCA(430,RCBILLDA,16)
. W !,?4,$P(^PRCA(430,PRCAIEN,0),U)," Cleared"
Q
4 ;option 4
I $D(^RCD(340,"TCSP",RCDEBTOR)) W !,"*** DEBTOR ALREADY CROSS-SERVICED ***" Q
S DIR(0)="D",DIR("A")="Enter Debtor Cross-Sevice Date" D ^DIR K DIR
I $D(DIRUT)!($D(DUOUT)) Q
S RCDATE=Y
S DIR(0)="YA",DIR("A")="File CS Debtor Change (Y/N): ",DIR("B")="N",DIR("?")="Enter (Y)es to file or (N)o to skip filing"
D ^DIR K DIR I Y=0!$G(DIRUT) W " < Debtor Not Updated >" Q
S RCDAS=RCDEBTOR_",",RCDR(340,RCDAS,7.05)=RCDATE D FILE^DIE("EK","RCDR","RCDERR") I $D(RCDERR) W " <",$G(RCDERR("DIERR",1,"TEXT",1)),">" K RCDERR G 4
W " <DONE>"
Q
5 ;option 5
I $D(^PRCA(430,"TCSP",RCBILLDA)) W !,"*** BILL ALREADY CROSS-SERVICED, DEBTOR MUST BE ALSO ***" Q
I $D(^RCD(340,"TCSP",RCDEBTOR)) W !,"*** DEBTOR ALREADY CROSS-SERVICED, USE OPTION 1 TO SET BILL ***" Q
I $D(^PRCA(430,RCBILLDA,30)) W !,"*** BILL RETURNED BY RECONCILIATION ***" Q
S DIR(0)="D",DIR("A")="Enter Debtor Cross-Sevice Date" D ^DIR K DIR Q:$G(DIRUT)
S RCDATE=Y
S DIR(0)="YA",DIR("A")="File CS Debtor/Bill Change (Y/N): ",DIR("B")="N",DIR("?")="Enter (Y)es to file or (N)o to skip filing"
D ^DIR K DIR I Y=0!$G(DIRUT) W " < Debtor Not Updated >" Q
S RCDAS=RCDEBTOR_",",RCDR(340,RCDAS,7.05)=RCDATE D FILE^DIE("EK","RCDR","RCDERR") I $D(RCDERR) W " <",$G(RCDERR("DIERR",1,"TEXT",1)),">" K RCDERR G 5
S ^PRCA(430,RCBILLDA,15)="",DA=RCBILLDA,DIE="^PRCA(430,",DR="151////^S X=RCDATE" D ^DIE
D SET16 ;PRCA*4.5*336
W " <DONE>",!,">>> Bill Updating for CS info... "
W "fully re-established as Cross-Serviced >"
Q
;
SET16 ;SET NODE 16 FOR TCSP BILL ;PRCA*4.5*336
N RCXX,RCYY
S (RCDEBTR0,DEBTOR0)=$G(^RCD(340,RCDEBTOR,0)),DEBTOR1=$G(^RCD(340,RCDEBTOR,1)),RCDFN=+RCDEBTR0
S RCDPN16="",RCB6=$G(^PRCA(430,RCBILLDA,6)),RCB7=$G(^(7)),RCBILLDT=$P($P(RCB6,U,21),".")
S TAXID=$$TAXID(RCDEBTOR),RCNAME=$$NAME(+RCDEBTR0),RCNAME=$P(RCNAME,U)
S $P(RCDPN16,U)=TAXID,$P(RCDPN16,U,2)=RCNAME,$P(RCDPN16,U,3)=+RCBILLDT
S DEBTOR=RCDEBTOR,ADDRCS=$$ADDR^RCTCSP1(RCDFN,1),$P(RCDPN16,U,4,8)=$P(ADDRCS,U,1,5)
S $P(RCDPN16,U,12)=$S($P(ADDRCS,U,7)>2:$P(ADDRCS,U,7),+^PRCA(430,RCBILLDA,0)=436:2,1:1),$P(RCDPN16,U,13)=$P(^DPT(RCDFN,0),U,3)
S RCAMTRFD=0 F I=1:1:5 S RCAMTRFD=RCAMTRFD+$P(RCB7,U,I)
F I=9,10 S $P(RCDPN16,U,I)=RCAMTRFD
S (RCXX,RCYY)=$P(ADDRCS,U,6)
I RCXX'?10N D
. S RCYY="" F I=1:1:$L(RCXX) I $E(RCXX,I)?1N S RCYY=RCYY_$E(RCXX,I)
S $P(RCDPN16,U,11)=$E("000000000000",1,10-$L(RCYY))_RCYY
S ^PRCA(430,RCBILLDA,16)=RCDPN16
Q
;
TAXID(DEBTOR) ;computes TAXID to place on documents ;PRCA*4.5*343
N TAXID,DIC,DA,DR,DIQ
S TAXID=$$SSN^RCFN01(DEBTOR)
S TAXID=$$LJSF(TAXID,9)
Q TAXID
;
NAME(DFN) ;returns name for document and name in file ;PRCA*4.5*343
N FN,LN,MN,NM,DOCNM,VA,VADM
S NM=""
D DEM^VADPT
I $D(VADM) S NM=VADM(1)
S LN=$TR($P(NM,",")," .'-"),MN=$P($P(NM,",",2)," ",2)
I ($E(MN,1,2)="SR")!($E(MN,1,2)="JR")!(MN?2.3"I")!(MN?0.1"I"1"V"1.3"I") S MN=""
S FN=$P($P(NM,",",2)," ")
S DOCNM=$$LJ^XLFSTR($E(LN,1,35),35)_$$LJ^XLFSTR($E(FN,1,35),35)_$$LJ^XLFSTR($E(MN,1,35),35)
Q DOCNM
;
LJSF(X,Y) ;left justified space filled
S X=$E(X,1,Y)
S X=X_$$BLANK(Y-$L(X))
Q X
;
BLANK(X) ;returns 'x' blank spaces
N BLANK
S BLANK="",$P(BLANK," ",X+1)=""
Q BLANK
;
EXIT D KILL^XUSCLEAN Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPCSA 6709 printed Apr 09, 2024@20:43:44 Page 2
RCDPCSA ;UNY/RGB-CROSS-SERVICING STATUS FIX ;03/15/14 3:34 PM
+1 ;;4.5;Accounts Receivable;**325,336,343**;Mar 20, 1995;Build 59
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;OPTION: RCDP TCSP FLAG CONTROL
+4 ;
+5 ;PRCA*4.5*336 When setting bills to cross service date
+6 ; ensure the TCSP address node ^PRCA(430,ien,16)
+7 ; is established
+8 ;PRCA*4.5*343 Moved Name/taxid lookup into routine since they
+9 ; were moved from previous calls into RCTCSPD.
+10 ;
A SET U="^"
SET SITE=+$$SITE^VASITE
B KILL DIR
SET DIR(0)="SO^1:Set cross-service flag on BILL;2:Clear cross-service flag on BILL;3:Clear cross-service flag on DEBTOR (AND ALL BILLS);4:Set cross-service flag on DEBTOR;5:Fully re-establish debtor/bill as cross-serviced"
+1 SET DIR("?")="Enter an option number 1 to 5."
+2 SET DIR("A")="Select Number"
+3 DO ^DIR
+4 if $DATA(DIRUT)
GOTO EXIT
+5 SET PRCAOPT=+Y
+6 ;
C ;select bill
+1 ; returns -1 for timeout or ^, 0 for no selection, or ien of bill
+2 KILL %,%Y,C,DIC,DIR,DIE,DTOUT,DUOUT,X,Y
+3 KILL RCY,DIR,DIRUT
+4 WRITE !
SET DIC="^PRCA(430,"
SET DIC(0)="QEAM"
SET DIC("A")="Select BILL: "
+5 ; special lookup on input
+6 SET RCBEFLUP=1
+7 DO ^DIC
+8 IF $GET(DUOUT)!$GET(DTOUT)
GOTO B
+9 IF Y<0
GOTO B
+10 SET RCBILLDA=+Y
+11 ;Disp last 4 soc#
C1 IF '$DATA(^PRCA(430,"TCSP",RCBILLDA))
IF PRCAOPT=2
WRITE !,"*** BILL NOT CROSS SERVICED ***"
GOTO C
+1 IF $PIECE($GET(^PRCA(430,RCBILLDA,0)),U,8)'=16
WRITE !,"*** BILL NOT ACTIVE ***"
GOTO C
+2 SET RCDEBTOR=$PIECE($GET(^PRCA(430,RCBILLDA,0)),U,9)
IF 'RCDEBTOR
WRITE !," < *** debtor not found on bill *** >"
GOTO C
+3 SET RCDEBTV=$PIECE($GET(^RCD(340,RCDEBTOR,0)),U)
IF 'RCDEBTV
WRITE !," < *** debtor on bill not found *** >"
GOTO C
+4 IF RCDEBTV'["DPT("
WRITE !," < *** debtor must be a veteran *** >"
GOTO C
+5 IF '$DATA(^RCD(340,"TCSP",RCDEBTOR))
IF "245"'[PRCAOPT
WRITE !," <debtor not flagged as CS *** >"
GOTO C
+6 SET RCDPT=+RCDEBTV
SET RC0=$GET(^DPT(RCDPT,0))
IF RC0=""
WRITE !," < *** debtor info not found *** >"
GOTO C
+7 WRITE ?60,$EXTRACT($PIECE(RC0,U,9),6,9)
+8 DO @PRCAOPT
+9 GOTO C
1 ;option 1
+1 IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
WRITE !,"*** BILL ALREADY CROSS-SERVICED ***"
QUIT
+2 SET DIR(0)="D"
SET DIR("A")="Enter Cross-Sevice Date"
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)!($DATA(DUOUT))
QUIT
+4 SET RCDATE=Y
+5 SET DIR(0)="YA"
SET DIR("A")="File CS Bill Change (Y/N): "
SET DIR("B")="N"
SET DIR("?")="Enter (Y)es to file or (N)o to skip filing"
+6 DO ^DIR
KILL DIR
IF Y=0!$GET(DIRUT)
WRITE " < Bill Not Updated >"
QUIT
+7 SET RCDAS=RCBILLDA_","
SET PRCAR(430,RCDAS,151)=RCDATE
DO FILE^DIE("EK","PRCAR","PRCAERR")
IF $DATA(PRCAERR)
WRITE " <",$GET(PRCAERR("DIERR",1,"TEXT",1)),">"
KILL PRCAERR
GOTO 1
+8 ;PRCA*4.5*336
DO SET16
+9 WRITE " <DONE>"
+10 QUIT
2 ;option 2
+1 IF '$DATA(^PRCA(430,"TCSP",RCBILLDA))
WRITE !,"*** BILL NOT CROSS SERVICED ***"
QUIT
+2 SET DIR(0)="YA"
SET DIR("A")="File CS Bill Flag Removal (Y/N): "
SET DIR("B")="N"
SET DIR("?")="Enter (Y)es to file or (N)o to skip filing"
+3 DO ^DIR
KILL DIR
IF Y=0!$GET(DIRUT)
WRITE " <Bill Not Updated"
QUIT
+4 KILL ^PRCA(430,RCBILLDA,16)
+5 ;PRCA*4.5*336
SET DA=RCBILLDA
SET DIE="^PRCA(430,"
SET DR="151////@"
DO ^DIE
WRITE " <DONE>"
+6 QUIT
3 ;option 3
+1 SET DIR(0)="YA"
SET DIR("A")="File CS Debtor/Bills Flag Removal (Y/N): "
SET DIR("B")="N"
SET DIR("?")="Enter (Y)es to file or (N)o to skip filing"
+2 DO ^DIR
IF Y=0!$GET(DIRUT)
WRITE " <Bill Not Updated"
QUIT
+3 SET DA=RCDEBTOR
SET DIE="^RCD(340,"
SET DR="7.05////@"
DO ^DIE
WRITE " <DONE>"
+4 SET PRCAIEN=0
+5 FOR
SET PRCAIEN=$ORDER(^PRCA(430,"C",RCDEBTOR,PRCAIEN))
if 'PRCAIEN
QUIT
Begin DoDot:1
+6 IF '$DATA(^PRCA(430,"TCSP",PRCAIEN))
QUIT
+7 ;PRCA*4.5*336
SET DA=PRCAIEN
SET DIE="^PRCA(430,"
SET DR="151////@"
DO ^DIE
+8 KILL ^PRCA(430,RCBILLDA,16)
+9 WRITE !,?4,$PIECE(^PRCA(430,PRCAIEN,0),U)," Cleared"
End DoDot:1
+10 QUIT
4 ;option 4
+1 IF $DATA(^RCD(340,"TCSP",RCDEBTOR))
WRITE !,"*** DEBTOR ALREADY CROSS-SERVICED ***"
QUIT
+2 SET DIR(0)="D"
SET DIR("A")="Enter Debtor Cross-Sevice Date"
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)!($DATA(DUOUT))
QUIT
+4 SET RCDATE=Y
+5 SET DIR(0)="YA"
SET DIR("A")="File CS Debtor Change (Y/N): "
SET DIR("B")="N"
SET DIR("?")="Enter (Y)es to file or (N)o to skip filing"
+6 DO ^DIR
KILL DIR
IF Y=0!$GET(DIRUT)
WRITE " < Debtor Not Updated >"
QUIT
+7 SET RCDAS=RCDEBTOR_","
SET RCDR(340,RCDAS,7.05)=RCDATE
DO FILE^DIE("EK","RCDR","RCDERR")
IF $DATA(RCDERR)
WRITE " <",$GET(RCDERR("DIERR",1,"TEXT",1)),">"
KILL RCDERR
GOTO 4
+8 WRITE " <DONE>"
+9 QUIT
5 ;option 5
+1 IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
WRITE !,"*** BILL ALREADY CROSS-SERVICED, DEBTOR MUST BE ALSO ***"
QUIT
+2 IF $DATA(^RCD(340,"TCSP",RCDEBTOR))
WRITE !,"*** DEBTOR ALREADY CROSS-SERVICED, USE OPTION 1 TO SET BILL ***"
QUIT
+3 IF $DATA(^PRCA(430,RCBILLDA,30))
WRITE !,"*** BILL RETURNED BY RECONCILIATION ***"
QUIT
+4 SET DIR(0)="D"
SET DIR("A")="Enter Debtor Cross-Sevice Date"
DO ^DIR
KILL DIR
if $GET(DIRUT)
QUIT
+5 SET RCDATE=Y
+6 SET DIR(0)="YA"
SET DIR("A")="File CS Debtor/Bill Change (Y/N): "
SET DIR("B")="N"
SET DIR("?")="Enter (Y)es to file or (N)o to skip filing"
+7 DO ^DIR
KILL DIR
IF Y=0!$GET(DIRUT)
WRITE " < Debtor Not Updated >"
QUIT
+8 SET RCDAS=RCDEBTOR_","
SET RCDR(340,RCDAS,7.05)=RCDATE
DO FILE^DIE("EK","RCDR","RCDERR")
IF $DATA(RCDERR)
WRITE " <",$GET(RCDERR("DIERR",1,"TEXT",1)),">"
KILL RCDERR
GOTO 5
+9 SET ^PRCA(430,RCBILLDA,15)=""
SET DA=RCBILLDA
SET DIE="^PRCA(430,"
SET DR="151////^S X=RCDATE"
DO ^DIE
+10 ;PRCA*4.5*336
DO SET16
+11 WRITE " <DONE>",!,">>> Bill Updating for CS info... "
+12 WRITE "fully re-established as Cross-Serviced >"
+13 QUIT
+14 ;
SET16 ;SET NODE 16 FOR TCSP BILL ;PRCA*4.5*336
+1 NEW RCXX,RCYY
+2 SET (RCDEBTR0,DEBTOR0)=$GET(^RCD(340,RCDEBTOR,0))
SET DEBTOR1=$GET(^RCD(340,RCDEBTOR,1))
SET RCDFN=+RCDEBTR0
+3 SET RCDPN16=""
SET RCB6=$GET(^PRCA(430,RCBILLDA,6))
SET RCB7=$GET(^(7))
SET RCBILLDT=$PIECE($PIECE(RCB6,U,21),".")
+4 SET TAXID=$$TAXID(RCDEBTOR)
SET RCNAME=$$NAME(+RCDEBTR0)
SET RCNAME=$PIECE(RCNAME,U)
+5 SET $PIECE(RCDPN16,U)=TAXID
SET $PIECE(RCDPN16,U,2)=RCNAME
SET $PIECE(RCDPN16,U,3)=+RCBILLDT
+6 SET DEBTOR=RCDEBTOR
SET ADDRCS=$$ADDR^RCTCSP1(RCDFN,1)
SET $PIECE(RCDPN16,U,4,8)=$PIECE(ADDRCS,U,1,5)
+7 SET $PIECE(RCDPN16,U,12)=$SELECT($PIECE(ADDRCS,U,7)>2:$PIECE(ADDRCS,U,7),+^PRCA(430,RCBILLDA,0)=436:2,1:1)
SET $PIECE(RCDPN16,U,13)=$PIECE(^DPT(RCDFN,0),U,3)
+8 SET RCAMTRFD=0
FOR I=1:1:5
SET RCAMTRFD=RCAMTRFD+$PIECE(RCB7,U,I)
+9 FOR I=9,10
SET $PIECE(RCDPN16,U,I)=RCAMTRFD
+10 SET (RCXX,RCYY)=$PIECE(ADDRCS,U,6)
+11 IF RCXX'?10N
Begin DoDot:1
+12 SET RCYY=""
FOR I=1:1:$LENGTH(RCXX)
IF $EXTRACT(RCXX,I)?1N
SET RCYY=RCYY_$EXTRACT(RCXX,I)
End DoDot:1
+13 SET $PIECE(RCDPN16,U,11)=$EXTRACT("000000000000",1,10-$LENGTH(RCYY))_RCYY
+14 SET ^PRCA(430,RCBILLDA,16)=RCDPN16
+15 QUIT
+16 ;
TAXID(DEBTOR) ;computes TAXID to place on documents ;PRCA*4.5*343
+1 NEW TAXID,DIC,DA,DR,DIQ
+2 SET TAXID=$$SSN^RCFN01(DEBTOR)
+3 SET TAXID=$$LJSF(TAXID,9)
+4 QUIT TAXID
+5 ;
NAME(DFN) ;returns name for document and name in file ;PRCA*4.5*343
+1 NEW FN,LN,MN,NM,DOCNM,VA,VADM
+2 SET NM=""
+3 DO DEM^VADPT
+4 IF $DATA(VADM)
SET NM=VADM(1)
+5 SET LN=$TRANSLATE($PIECE(NM,",")," .'-")
SET MN=$PIECE($PIECE(NM,",",2)," ",2)
+6 IF ($EXTRACT(MN,1,2)="SR")!($EXTRACT(MN,1,2)="JR")!(MN?2.3"I")!(MN?0.1"I"1"V"1.3"I")
SET MN=""
+7 SET FN=$PIECE($PIECE(NM,",",2)," ")
+8 SET DOCNM=$$LJ^XLFSTR($EXTRACT(LN,1,35),35)_$$LJ^XLFSTR($EXTRACT(FN,1,35),35)_$$LJ^XLFSTR($EXTRACT(MN,1,35),35)
+9 QUIT DOCNM
+10 ;
LJSF(X,Y) ;left justified space filled
+1 SET X=$EXTRACT(X,1,Y)
+2 SET X=X_$$BLANK(Y-$LENGTH(X))
+3 QUIT X
+4 ;
BLANK(X) ;returns 'x' blank spaces
+1 NEW BLANK
+2 SET BLANK=""
SET $PIECE(BLANK," ",X+1)=""
+3 QUIT BLANK
+4 ;
EXIT DO KILL^XUSCLEAN
QUIT
