- RCTCSJS ;ALBANY/LEG - CROSS-SERVICING REJECTS SERVER;02/19/14 3:21 PM
- V ;;4.5;Accounts Receivable;**301,323,336,343**;Mar 20, 1995;Build 59
- ;;Per VA Directive 6402, this routine should not be modified.
- ;Program to process CS REJECT server messages from AITC
- ;
- ;PRCA*4.5*323 a. Convert reject rec totals to absolute value
- ; b. Allow C2 B rec type or '3E' reject clear CS flag
- ;
- ;PRCA*4.5*336 Ensure CS date is reset for rejected recalls on bills
- ;
- ;PRCA*4.5*343 Only set the CS date for rejected recall transaction
- ; if the bill status is active (16).
- ;
- ;===============================================================================
- SERVER G SERVER^RCTCSJS0
- ;
- SETREJS ;
- S IDXS=".01;1;2;3;4;5;6;7;8;9;10;11;12;13;14"
- S BILLIEN=""
- F S BILLIEN=$O(^XTMP(NMSPC,$J,"BILL",BILLIEN)),SBILL="" Q:'$L(BILLIEN) D ;
- . F S SBILL=$O(^XTMP(NMSPC,$J,"BILL",BILLIEN,SBILL)),HDATE="" Q:'$L(SBILL) D ;
- .. F S HDATE=$O(^XTMP(NMSPC,$J,"BILL",BILLIEN,SBILL,HDATE)),CSRC="" Q:'$L(HDATE) D ;
- ... F S CSRC=$O(^XTMP(NMSPC,$J,"BILL",BILLIEN,SBILL,HDATE,CSRC)),RTYP="" Q:CSRC="" D ;
- .... F S RTYP=$O(^XTMP(NMSPC,$J,"BILL",BILLIEN,SBILL,HDATE,CSRC,RTYP)),RACTN="" Q:RTYP="" D ;
- ..... F S RACTN=$O(^XTMP(NMSPC,$J,"BILL",BILLIEN,SBILL,HDATE,CSRC,RTYP,RACTN)) Q:RACTN="" D ;
- ...... S CERRS=$P(^XTMP(NMSPC,$J,"BILL",BILLIEN,SBILL,HDATE,CSRC,RTYP,RACTN),U)
- ...... S ^XTMP(NMSPC,$J,"ERRCDS",CERRS,BILLIEN)="" ; log by errs found
- ...... S REC=ZDATE_U_CSRC_U_$TR(CERRS,",","^")
- ...... S $P(REC,U,12)=RTYP,$P(REC,U,13)=RACTN,$P(REC,U,14)=BCIDA,$P(REC,U,15)=XMZ
- ...... S PATID=$P(^PRCA(430,BILLIEN,0),U,7),OTHERID=$P(^PRCA(430,BILLIEN,0),U,9)
- ...... I OTHERID D ;
- ....... S IDNUMGLB=$P(^RCD(340,OTHERID,0),U),IDGLOB=$P(IDNUMGLB,";",2),IDNUM=+IDNUMGLB
- ....... S IDREC0=@("^"_IDGLOB_IDNUM_",0)")
- ....... S NAM=$P(IDREC0,U),SSN=$P(IDREC0,U,9)
- ...... I PATID S NAM=$P(^DPT(PATID,0),U),SSN=$P(^DPT(PATID,0),U,9)
- ...... S STATCNT=STATCNT-1
- ...... D UPDREJ
- Q ; SETREJS
- ;
- UPDREJ ;
- K DR,DA,DD,DO,Y
- ;
- ; checks for valid bill
- S DIC="^PRCA(430,",DIC(0)="KMNZ",X=BILLIEN D ^DIC
- S KBILL=$E(SBILL,5,11)
- ;
- ; Set ID for errors if ARTXNID not available
- N ERRORID
- S ERRORID=$S($G(ARTXNID(BILLIEN))="":U_U_RECN,1:ARTXNID(BILLIEN))
- ;
- I Y=-1 D Q ;
- . S ZMSG="Unknown Bill: "_BILLIEN_"/"_SBILL_"/"_RTYP
- . D RECERR(.ERRCNT,"UNK-BILL:",ZMSG,$P(ERRORID,U,3),.RECERR) Q ; UPDREJ ;
- ; checks if REJECT record was previously logged
- S COMMENT="XMB "_XMZ_" "_BCIDA
- ;I $D(^PRCA(430,BILLIEN,18,"B",ZDATE)) D Q:PREV ;UPDREJ
- ;. S IDX="",PREV=0
- ;. F S IDX=$O(^PRCA(430,BILLIEN,18,"B",ZDATE,IDX)) Q:'IDX D ;
- ;.. I $P(^PRCA(430,BILLIEN,18,IDX,0),U,1,14)=$P(REC,U,1,14) S PREV=1 Q
- ;. I PREV D ;
- ;. . S ZMSG="BILL Previously Logged IEN: "_BILLIEN_"/"_SBILL_"/"_RTYP
- ;. . D RECERR(.ERRCNT,"BILL PREV LOGGED",ZMSG,$P(ERRORID,U,3),.RECERR)
- ;
- ; gets next rejects subfile entry number
- K DR,DA,DD,DO
- S DA(1)=+Y
- S DIC="^PRCA(430,"_DA(1)_",18,"
- S DIC(0)="KMNZ"
- S DIC("P")=$P(^DD(430,172,0),"^",2)
- S (DA,X)=$O(@(DIC_"""A"")"),-1)
- D ^DIC
- ;
- ; set Reject Fields
- K DD,DO
- S DA(1)=BILLIEN
- ; S DA=$S(Y=-1:1,1:DA+1)
- S DA=$S($O(^PRCA(430,BILLIEN,18,"A"),-1):($O(^PRCA(430,BILLIEN,18,"A"),-1)+1),1:1)
- S DIE=DIC K DIC
- S DR=""
- D RJCDCONV
- F PC=1:1:15 S DTA=$P(REC,U,PC) I $L(DTA) S DR=DR_$P(IDXS,";",PC)_"////"_DTA_";"
- S DIC("DR")=DR
- I $L(DR) D ;
- . D ^DIE
- . ; Re-Index AB x_ref
- . S DIK(1)=".01^AB^B"
- . S DIK="^PRCA(430,"_BILLIEN_",18," D ENALL^DIK ;,DA(1)=HDATE
- . S $P(^PRCA(430,BILLIEN,18,0),U,3)=$O(^PRCA(430,BILLIEN,18,"A"),-1)
- . ;
- . D STOPFILE ; resets STOP TCSP REFERRAL FLAG
- . D LOGBULTN ; logs data into Bulletin
- Q ;UPDREJ
- ;
- STOPFILE ;set stop referral data in file 430
- N B0,DEBTOR,BTRNNUM
- S B0=$G(^PRCA(430,BILLIEN,0))
- S $P(^PRCA(430,BILLIEN,15),U,7,10)="1^"_RUNDT_U_"R"_U_$G(COMMENT)
- I RTYP=1 D Q
- .I RACTN="A" K ^PRCA(430,BILLIEN,15),^(16),^PRCA(430,"TCSP",BILLIEN)
- .I RACTN="U" S $P(^PRCA(430,BILLIEN,19),U,1)="1" Q
- .I RACTN="L" D Q ;PRCA*4.5*336
- .. K DR I $P(^PRCA(430,BILLIEN,0),U,8)=16 S DR="151////^S X=DT;" ;PRCA*4.5*343
- .. S DA=BILLIEN,DIE="^PRCA(430,",DR=$G(DR)_"152///@;153///@;154///@;155///@" D ^DIE K DIE,DR,DA ;PRCA*4.5*336/343
- I RTYP="2" S DEBTOR=$P(B0,U,9) D Q
- .I RACTN="A" K ^RCD(340,DEBTOR,7),^RCD(340,"TCSP",DEBTOR) Q
- .I RACTN="B",$G(CERRS)["3E" K ^PRCA(430,BILLIEN,15),^(16),^PRCA(430,"TCSP",BILLIEN)
- .I RACTN="L" D Q ;PRCA*4.5*336
- .. S DA=DEBTOR,DIE="^RCD(340,",DR="7.02///@;7.03///@;7.04///@" D ^DIE K DIE,DR,DA ;PRCA*4.5*336/343
- .. K DR I $P(^PRCA(430,BILLIEN,0),U,8)=16 S DR="151////^S X=DT;" ;PRCA*4.5*343
- .. S DA=BILLIEN,DIE="^PRCA(430,",DR=$G(DR)_"152///@;153///@;154///@;155///@" D ^DIE K DIE,DR,DA ;PRCA*4.5*336/343
- .I RACTN="U" S $P(^PRCA(430,BILLIEN,19),U,2)="1" Q
- I RTYP="2A" D Q
- .I RACTN="A" Q
- .I RACTN="U" S $P(^PRCA(430,BILLIEN,19),U,3)="1" Q
- I RTYP="2C" D Q
- . I RACTN="A" S $P(^PRCA(430,BILLIEN,19),U,4)="1" Q
- I RTYP=3 Q
- I RTYP="5B" D Q
- .I RACTN="U" I $D(ARTXNID(BILLIEN)) S TRNNUM=+$P(ARTXNID(BILLIEN),U,1) I TRNNUM D
- ..;N INDX
- ..S INDX=0
- ..F S INDX=$O(^PRCA(430,BILLIEN,17,INDX)) Q:+INDX=0 I $P($G(^PRCA(430,BILLIEN,17,INDX,0)),U,1)=TRNNUM S $P(^PRCA(430,BILLIEN,17,INDX,0),U,2)=1 S DR="151///DT",DIE="^PRCA(430,",DA=BILLIEN D ^DIE Q
- Q
- ;
- RECERR(ERRCNT,ETYP,ERRDATA,RECN,RECERR) ; log TRANSMITTED FORMAT err
- S (ERRCNT,^XTMP(NMSPC,$J,"ERR",0))=$G(^XTMP(NMSPC,$J,"ERR",0))+1
- S ^XTMP(NMSPC,$J,"ERR",ERRCNT)=RECN_U_ERRDATA
- S RECERR=1
- Q ;
- LOGBULTN ; logs the bulletin records
- S ERRS=$S($E(CERRS,$L(CERRS))=",":$E(CERRS,1,$L(CERRS)-1),1:CERRS)
- S BLTNCNT=$G(BLTNCNT)+1
- S BLTNREC=$E(NAM_BLNKS,1,20)_" "_$E(SSN_BLNKS,1,10)_$E(SBILL_BLNKS,1,12)
- S BLTNREC=BLTNREC_$E(RTYP_BLNKS,1,5)_$E(RACTN_BLNKS,1,5)_$E($P(CERRS,",",1,$L(CERRS,",")-1)_BLNKS,1,26)
- ;
- S ^XTMP(NMSPC,$J,"BULTN",BLTNCNT)=BLTNREC
- S ^XTMP(NMSPC,$J,"SRC",CSRC,NAM,SBILL,BLTNCNT)=""
- Q
- RJCDCONV ;Will modify code string to convert code data to linked file pointer
- N COD,CVI
- F CVI=3:1:13 S COD=$P(REC,U,CVI) D:COD'=""
- . I CVI>2,CVI<12 S COD=$O(^RC(348.5,"B",COD,0)),$P(REC,U,CVI)=COD Q
- . I CVI=12 S COD=$O(^RC(348.7,"B",COD,0)),$P(REC,U,CVI)=COD Q
- . I CVI=13 S COD=$O(^RC(348.6,"B",COD,0)),$P(REC,U,CVI)=COD
- . Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCTCSJS 6370 printed Mar 13, 2025@20:53:22 Page 2
- RCTCSJS ;ALBANY/LEG - CROSS-SERVICING REJECTS SERVER;02/19/14 3:21 PM
- V ;;4.5;Accounts Receivable;**301,323,336,343**;Mar 20, 1995;Build 59
- +1 ;;Per VA Directive 6402, this routine should not be modified.
- +2 ;Program to process CS REJECT server messages from AITC
- +3 ;
- +4 ;PRCA*4.5*323 a. Convert reject rec totals to absolute value
- +5 ; b. Allow C2 B rec type or '3E' reject clear CS flag
- +6 ;
- +7 ;PRCA*4.5*336 Ensure CS date is reset for rejected recalls on bills
- +8 ;
- +9 ;PRCA*4.5*343 Only set the CS date for rejected recall transaction
- +10 ; if the bill status is active (16).
- +11 ;
- +12 ;===============================================================================
- SERVER GOTO SERVER^RCTCSJS0
- +1 ;
- SETREJS ;
- +1 SET IDXS=".01;1;2;3;4;5;6;7;8;9;10;11;12;13;14"
- +2 SET BILLIEN=""
- +3 ;
- FOR
- SET BILLIEN=$ORDER(^XTMP(NMSPC,$JOB,"BILL",BILLIEN))
- SET SBILL=""
- if '$LENGTH(BILLIEN)
- QUIT
- Begin DoDot:1
- +4 ;
- FOR
- SET SBILL=$ORDER(^XTMP(NMSPC,$JOB,"BILL",BILLIEN,SBILL))
- SET HDATE=""
- if '$LENGTH(SBILL)
- QUIT
- Begin DoDot:2
- +5 ;
- FOR
- SET HDATE=$ORDER(^XTMP(NMSPC,$JOB,"BILL",BILLIEN,SBILL,HDATE))
- SET CSRC=""
- if '$LENGTH(HDATE)
- QUIT
- Begin DoDot:3
- +6 ;
- FOR
- SET CSRC=$ORDER(^XTMP(NMSPC,$JOB,"BILL",BILLIEN,SBILL,HDATE,CSRC))
- SET RTYP=""
- if CSRC=""
- QUIT
- Begin DoDot:4
- +7 ;
- FOR
- SET RTYP=$ORDER(^XTMP(NMSPC,$JOB,"BILL",BILLIEN,SBILL,HDATE,CSRC,RTYP))
- SET RACTN=""
- if RTYP=""
- QUIT
- Begin DoDot:5
- +8 ;
- FOR
- SET RACTN=$ORDER(^XTMP(NMSPC,$JOB,"BILL",BILLIEN,SBILL,HDATE,CSRC,RTYP,RACTN))
- if RACTN=""
- QUIT
- Begin DoDot:6
- +9 SET CERRS=$PIECE(^XTMP(NMSPC,$JOB,"BILL",BILLIEN,SBILL,HDATE,CSRC,RTYP,RACTN),U)
- +10 ; log by errs found
- SET ^XTMP(NMSPC,$JOB,"ERRCDS",CERRS,BILLIEN)=""
- +11 SET REC=ZDATE_U_CSRC_U_$TRANSLATE(CERRS,",","^")
- +12 SET $PIECE(REC,U,12)=RTYP
- SET $PIECE(REC,U,13)=RACTN
- SET $PIECE(REC,U,14)=BCIDA
- SET $PIECE(REC,U,15)=XMZ
- +13 SET PATID=$PIECE(^PRCA(430,BILLIEN,0),U,7)
- SET OTHERID=$PIECE(^PRCA(430,BILLIEN,0),U,9)
- +14 ;
- IF OTHERID
- Begin DoDot:7
- +15 SET IDNUMGLB=$PIECE(^RCD(340,OTHERID,0),U)
- SET IDGLOB=$PIECE(IDNUMGLB,";",2)
- SET IDNUM=+IDNUMGLB
- +16 SET IDREC0=@("^"_IDGLOB_IDNUM_",0)")
- +17 SET NAM=$PIECE(IDREC0,U)
- SET SSN=$PIECE(IDREC0,U,9)
- End DoDot:7
- +18 IF PATID
- SET NAM=$PIECE(^DPT(PATID,0),U)
- SET SSN=$PIECE(^DPT(PATID,0),U,9)
- +19 SET STATCNT=STATCNT-1
- +20 DO UPDREJ
- End DoDot:6
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 ; SETREJS
- QUIT
- +22 ;
- UPDREJ ;
- +1 KILL DR,DA,DD,DO,Y
- +2 ;
- +3 ; checks for valid bill
- +4 SET DIC="^PRCA(430,"
- SET DIC(0)="KMNZ"
- SET X=BILLIEN
- DO ^DIC
- +5 SET KBILL=$EXTRACT(SBILL,5,11)
- +6 ;
- +7 ; Set ID for errors if ARTXNID not available
- +8 NEW ERRORID
- +9 SET ERRORID=$SELECT($GET(ARTXNID(BILLIEN))="":U_U_RECN,1:ARTXNID(BILLIEN))
- +10 ;
- +11 ;
- IF Y=-1
- Begin DoDot:1
- +12 SET ZMSG="Unknown Bill: "_BILLIEN_"/"_SBILL_"/"_RTYP
- +13 ; UPDREJ ;
- DO RECERR(.ERRCNT,"UNK-BILL:",ZMSG,$PIECE(ERRORID,U,3),.RECERR)
- QUIT
- End DoDot:1
- QUIT
- +14 ; checks if REJECT record was previously logged
- +15 SET COMMENT="XMB "_XMZ_" "_BCIDA
- +16 ;I $D(^PRCA(430,BILLIEN,18,"B",ZDATE)) D Q:PREV ;UPDREJ
- +17 ;. S IDX="",PREV=0
- +18 ;. F S IDX=$O(^PRCA(430,BILLIEN,18,"B",ZDATE,IDX)) Q:'IDX D ;
- +19 ;.. I $P(^PRCA(430,BILLIEN,18,IDX,0),U,1,14)=$P(REC,U,1,14) S PREV=1 Q
- +20 ;. I PREV D ;
- +21 ;. . S ZMSG="BILL Previously Logged IEN: "_BILLIEN_"/"_SBILL_"/"_RTYP
- +22 ;. . D RECERR(.ERRCNT,"BILL PREV LOGGED",ZMSG,$P(ERRORID,U,3),.RECERR)
- +23 ;
- +24 ; gets next rejects subfile entry number
- +25 KILL DR,DA,DD,DO
- +26 SET DA(1)=+Y
- +27 SET DIC="^PRCA(430,"_DA(1)_",18,"
- +28 SET DIC(0)="KMNZ"
- +29 SET DIC("P")=$PIECE(^DD(430,172,0),"^",2)
- +30 SET (DA,X)=$ORDER(@(DIC_"""A"")"),-1)
- +31 DO ^DIC
- +32 ;
- +33 ; set Reject Fields
- +34 KILL DD,DO
- +35 SET DA(1)=BILLIEN
- +36 ; S DA=$S(Y=-1:1,1:DA+1)
- +37 SET DA=$SELECT($ORDER(^PRCA(430,BILLIEN,18,"A"),-1):($ORDER(^PRCA(430,BILLIEN,18,"A"),-1)+1),1:1)
- +38 SET DIE=DIC
- KILL DIC
- +39 SET DR=""
- +40 DO RJCDCONV
- +41 FOR PC=1:1:15
- SET DTA=$PIECE(REC,U,PC)
- IF $LENGTH(DTA)
- SET DR=DR_$PIECE(IDXS,";",PC)_"////"_DTA_";"
- +42 SET DIC("DR")=DR
- +43 ;
- IF $LENGTH(DR)
- Begin DoDot:1
- +44 DO ^DIE
- +45 ; Re-Index AB x_ref
- +46 SET DIK(1)=".01^AB^B"
- +47 ;,DA(1)=HDATE
- SET DIK="^PRCA(430,"_BILLIEN_",18,"
- DO ENALL^DIK
- +48 SET $PIECE(^PRCA(430,BILLIEN,18,0),U,3)=$ORDER(^PRCA(430,BILLIEN,18,"A"),-1)
- +49 ;
- +50 ; resets STOP TCSP REFERRAL FLAG
- DO STOPFILE
- +51 ; logs data into Bulletin
- DO LOGBULTN
- End DoDot:1
- +52 ;UPDREJ
- QUIT
- +53 ;
- STOPFILE ;set stop referral data in file 430
- +1 NEW B0,DEBTOR,BTRNNUM
- +2 SET B0=$GET(^PRCA(430,BILLIEN,0))
- +3 SET $PIECE(^PRCA(430,BILLIEN,15),U,7,10)="1^"_RUNDT_U_"R"_U_$GET(COMMENT)
- +4 IF RTYP=1
- Begin DoDot:1
- +5 IF RACTN="A"
- KILL ^PRCA(430,BILLIEN,15),^(16),^PRCA(430,"TCSP",BILLIEN)
- +6 IF RACTN="U"
- SET $PIECE(^PRCA(430,BILLIEN,19),U,1)="1"
- QUIT
- +7 ;PRCA*4.5*336
- IF RACTN="L"
- Begin DoDot:2
- +8 ;PRCA*4.5*343
- KILL DR
- IF $PIECE(^PRCA(430,BILLIEN,0),U,8)=16
- SET DR="151////^S X=DT;"
- +9 ;PRCA*4.5*336/343
- SET DA=BILLIEN
- SET DIE="^PRCA(430,"
- SET DR=$GET(DR)_"152///@;153///@;154///@;155///@"
- DO ^DIE
- KILL DIE,DR,DA
- End DoDot:2
- QUIT
- End DoDot:1
- QUIT
- +10 IF RTYP="2"
- SET DEBTOR=$PIECE(B0,U,9)
- Begin DoDot:1
- +11 IF RACTN="A"
- KILL ^RCD(340,DEBTOR,7),^RCD(340,"TCSP",DEBTOR)
- QUIT
- +12 IF RACTN="B"
- IF $GET(CERRS)["3E"
- KILL ^PRCA(430,BILLIEN,15),^(16),^PRCA(430,"TCSP",BILLIEN)
- +13 ;PRCA*4.5*336
- IF RACTN="L"
- Begin DoDot:2
- +14 ;PRCA*4.5*336/343
- SET DA=DEBTOR
- SET DIE="^RCD(340,"
- SET DR="7.02///@;7.03///@;7.04///@"
- DO ^DIE
- KILL DIE,DR,DA
- +15 ;PRCA*4.5*343
- KILL DR
- IF $PIECE(^PRCA(430,BILLIEN,0),U,8)=16
- SET DR="151////^S X=DT;"
- +16 ;PRCA*4.5*336/343
- SET DA=BILLIEN
- SET DIE="^PRCA(430,"
- SET DR=$GET(DR)_"152///@;153///@;154///@;155///@"
- DO ^DIE
- KILL DIE,DR,DA
- End DoDot:2
- QUIT
- +17 IF RACTN="U"
- SET $PIECE(^PRCA(430,BILLIEN,19),U,2)="1"
- QUIT
- End DoDot:1
- QUIT
- +18 IF RTYP="2A"
- Begin DoDot:1
- +19 IF RACTN="A"
- QUIT
- +20 IF RACTN="U"
- SET $PIECE(^PRCA(430,BILLIEN,19),U,3)="1"
- QUIT
- End DoDot:1
- QUIT
- +21 IF RTYP="2C"
- Begin DoDot:1
- +22 IF RACTN="A"
- SET $PIECE(^PRCA(430,BILLIEN,19),U,4)="1"
- QUIT
- End DoDot:1
- QUIT
- +23 IF RTYP=3
- QUIT
- +24 IF RTYP="5B"
- Begin DoDot:1
- +25 IF RACTN="U"
- IF $DATA(ARTXNID(BILLIEN))
- SET TRNNUM=+$PIECE(ARTXNID(BILLIEN),U,1)
- IF TRNNUM
- Begin DoDot:2
- +26 ;N INDX
- +27 SET INDX=0
- +28 FOR
- SET INDX=$ORDER(^PRCA(430,BILLIEN,17,INDX))
- if +INDX=0
- QUIT
- IF $PIECE($GET(^PRCA(430,BILLIEN,17,INDX,0)),U,1)=TRNNUM
- SET $PIECE(^PRCA(430,BILLIEN,17,INDX,0),U,2)=1
- SET DR="151///DT"
- SET DIE="^PRCA(430,"
- SET DA=BILLIEN
- DO ^DIE
- QUIT
- End DoDot:2
- End DoDot:1
- QUIT
- +29 QUIT
- +30 ;
- RECERR(ERRCNT,ETYP,ERRDATA,RECN,RECERR) ; log TRANSMITTED FORMAT err
- +1 SET (ERRCNT,^XTMP(NMSPC,$JOB,"ERR",0))=$GET(^XTMP(NMSPC,$JOB,"ERR",0))+1
- +2 SET ^XTMP(NMSPC,$JOB,"ERR",ERRCNT)=RECN_U_ERRDATA
- +3 SET RECERR=1
- +4 ;
- QUIT
- LOGBULTN ; logs the bulletin records
- +1 SET ERRS=$SELECT($EXTRACT(CERRS,$LENGTH(CERRS))=",":$EXTRACT(CERRS,1,$LENGTH(CERRS)-1),1:CERRS)
- +2 SET BLTNCNT=$GET(BLTNCNT)+1
- +3 SET BLTNREC=$EXTRACT(NAM_BLNKS,1,20)_" "_$EXTRACT(SSN_BLNKS,1,10)_$EXTRACT(SBILL_BLNKS,1,12)
- +4 SET BLTNREC=BLTNREC_$EXTRACT(RTYP_BLNKS,1,5)_$EXTRACT(RACTN_BLNKS,1,5)_$EXTRACT($PIECE(CERRS,",",1,$LENGTH(CERRS,",")-1)_BLNKS,1,26)
- +5 ;
- +6 SET ^XTMP(NMSPC,$JOB,"BULTN",BLTNCNT)=BLTNREC
- +7 SET ^XTMP(NMSPC,$JOB,"SRC",CSRC,NAM,SBILL,BLTNCNT)=""
- +8 QUIT
- RJCDCONV ;Will modify code string to convert code data to linked file pointer
- +1 NEW COD,CVI
- +2 FOR CVI=3:1:13
- SET COD=$PIECE(REC,U,CVI)
- if COD'=""
- Begin DoDot:1
- +3 IF CVI>2
- IF CVI<12
- SET COD=$ORDER(^RC(348.5,"B",COD,0))
- SET $PIECE(REC,U,CVI)=COD
- QUIT
- +4 IF CVI=12
- SET COD=$ORDER(^RC(348.7,"B",COD,0))
- SET $PIECE(REC,U,CVI)=COD
- QUIT
- +5 IF CVI=13
- SET COD=$ORDER(^RC(348.6,"B",COD,0))
- SET $PIECE(REC,U,CVI)=COD
- +6 QUIT
- End DoDot:1
