- RCXFMSTR ;WASH-ISC@ALTOONA,PA/CLH-TRI CARE EXTRACT ROUTINE ;1 Oct 97
- ;;4.5;Accounts Receivable;**90,148**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- ;
- ;
- EN ; creates report from TRI data in file 423.6
- N %,BILL,BILLDA,DATA,LINE,LINEDA,SUBJECT,TRICARDA,XMSUB,XMDUZ,XMY,XMZ,Y
- K ^TMP($J,"RCXFMSTR"),^TMP($J,"RCXFMSTRXMB")
- ;
- S SUBJECT="TRI-"
- F S SUBJECT=$O(^PRCF(423.6,"B",SUBJECT)) Q:$E(SUBJECT,1,4)'="TRI-" D
- . S TRICARDA=$O(^PRCF(423.6,"B",SUBJECT,0)) Q:'TRICARDA
- . ;
- . ; loop through the bills and set the line number
- . S LINEDA=0 F S LINEDA=$O(^PRCF(423.6,TRICARDA,1,LINEDA)) Q:'LINEDA D
- . . S DATA=$G(^PRCF(423.6,TRICARDA,1,LINEDA,0)) I DATA="" Q
- . . I $E(DATA,1,3)'="TRI" Q
- . . S BILL=$E($P(DATA,"^",4),1,3)_"-"_$E($P(DATA,"^",4),4,10)
- . . S BILLDA=$O(^PRCA(430,"B",BILL,0))
- . . I 'BILLDA S ^TMP($J,"RCXFMSTR","NOTFOUND",BILL)=$P(DATA,"^",6) Q
- . . ;
- . . ; store the line number
- . . S $P(^PRCA(430,BILLDA,11),"^",4)=$P(DATA,"^",5)
- . . S ^TMP($J,"RCXFMSTR","CONVERT",BILLDA)=BILL_"^"_$P(DATA,"^",6)
- ;
- ; send report
- D NOW^%DTC S Y=% D DD^%DT
- S ^TMP($J,"RCXFMSTRXMB",1)="Date of Report: "_Y
- S ^TMP($J,"RCXFMSTRXMB",2)="NOTE: This report contains the records which FMS"
- S ^TMP($J,"RCXFMSTRXMB",3)="has moved to current fiscal year."
- S ^TMP($J,"RCXFMSTRXMB",4)=" "
- S ^TMP($J,"RCXFMSTRXMB",5)="No FMS data exists to report!"
- ;
- S LINE=4
- I $O(^TMP($J,"RCXFMSTR","NOTFOUND",""))'="" D
- . D SET(" ")
- . D SET("The following bills were not found in AR and could not be converted:")
- . S BILL="" F S BILL=$O(^TMP($J,"RCXFMSTR","NOTFOUND",BILL)) Q:BILL="" D SET(" "_BILL_$J(^(BILL),20,2))
- ;
- I $O(^TMP($J,"RCXFMSTR","CONVERT",0)) D
- . D SET(" ")
- . D SET("The following bills were converted and moved to current fiscal year:")
- . S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCXFMSTR","CONVERT",BILLDA)) Q:'BILLDA D SET(" "_$P(^(BILLDA),"^")_$J($P(^(BILLDA),"^",2),20,2))
- ;
- S XMTEXT="^TMP($J,""RCXFMSTRXMB"","
- S XMSUB="FMS PRIOR YEAR RECEIVABLES"
- S XMDUZ="Accounts Receivable Package",XMY("G.FMS")="",XMY(DUZ)=""
- D ^XMD
- ;
- K ^TMP($J,"RCXFMSTR"),^TMP($J,"RCXFMSTRXMB")
- Q
- ;
- ;
- SET(STRING) ; set the line for the report
- S LINE=LINE+1,^TMP($J,"RCXFMSTRXMB",LINE)=STRING
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCXFMSTR 2358 printed Jan 18, 2025@02:50:32 Page 2
- RCXFMSTR ;WASH-ISC@ALTOONA,PA/CLH-TRI CARE EXTRACT ROUTINE ;1 Oct 97
- +1 ;;4.5;Accounts Receivable;**90,148**;Mar 20, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- +4 ;
- +5 ;
- EN ; creates report from TRI data in file 423.6
- +1 NEW %,BILL,BILLDA,DATA,LINE,LINEDA,SUBJECT,TRICARDA,XMSUB,XMDUZ,XMY,XMZ,Y
- +2 KILL ^TMP($JOB,"RCXFMSTR"),^TMP($JOB,"RCXFMSTRXMB")
- +3 ;
- +4 SET SUBJECT="TRI-"
- +5 FOR
- SET SUBJECT=$ORDER(^PRCF(423.6,"B",SUBJECT))
- if $EXTRACT(SUBJECT,1,4)'="TRI-"
- QUIT
- Begin DoDot:1
- +6 SET TRICARDA=$ORDER(^PRCF(423.6,"B",SUBJECT,0))
- if 'TRICARDA
- QUIT
- +7 ;
- +8 ; loop through the bills and set the line number
- +9 SET LINEDA=0
- FOR
- SET LINEDA=$ORDER(^PRCF(423.6,TRICARDA,1,LINEDA))
- if 'LINEDA
- QUIT
- Begin DoDot:2
- +10 SET DATA=$GET(^PRCF(423.6,TRICARDA,1,LINEDA,0))
- IF DATA=""
- QUIT
- +11 IF $EXTRACT(DATA,1,3)'="TRI"
- QUIT
- +12 SET BILL=$EXTRACT($PIECE(DATA,"^",4),1,3)_"-"_$EXTRACT($PIECE(DATA,"^",4),4,10)
- +13 SET BILLDA=$ORDER(^PRCA(430,"B",BILL,0))
- +14 IF 'BILLDA
- SET ^TMP($JOB,"RCXFMSTR","NOTFOUND",BILL)=$PIECE(DATA,"^",6)
- QUIT
- +15 ;
- +16 ; store the line number
- +17 SET $PIECE(^PRCA(430,BILLDA,11),"^",4)=$PIECE(DATA,"^",5)
- +18 SET ^TMP($JOB,"RCXFMSTR","CONVERT",BILLDA)=BILL_"^"_$PIECE(DATA,"^",6)
- End DoDot:2
- End DoDot:1
- +19 ;
- +20 ; send report
- +21 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- +22 SET ^TMP($JOB,"RCXFMSTRXMB",1)="Date of Report: "_Y
- +23 SET ^TMP($JOB,"RCXFMSTRXMB",2)="NOTE: This report contains the records which FMS"
- +24 SET ^TMP($JOB,"RCXFMSTRXMB",3)="has moved to current fiscal year."
- +25 SET ^TMP($JOB,"RCXFMSTRXMB",4)=" "
- +26 SET ^TMP($JOB,"RCXFMSTRXMB",5)="No FMS data exists to report!"
- +27 ;
- +28 SET LINE=4
- +29 IF $ORDER(^TMP($JOB,"RCXFMSTR","NOTFOUND",""))'=""
- Begin DoDot:1
- +30 DO SET(" ")
- +31 DO SET("The following bills were not found in AR and could not be converted:")
- +32 SET BILL=""
- FOR
- SET BILL=$ORDER(^TMP($JOB,"RCXFMSTR","NOTFOUND",BILL))
- if BILL=""
- QUIT
- DO SET(" "_BILL_$JUSTIFY(^(BILL),20,2))
- End DoDot:1
- +33 ;
- +34 IF $ORDER(^TMP($JOB,"RCXFMSTR","CONVERT",0))
- Begin DoDot:1
- +35 DO SET(" ")
- +36 DO SET("The following bills were converted and moved to current fiscal year:")
- +37 SET BILLDA=0
- FOR
- SET BILLDA=$ORDER(^TMP($JOB,"RCXFMSTR","CONVERT",BILLDA))
- if 'BILLDA
- QUIT
- DO SET(" "_$PIECE(^(BILLDA),"^")_$JUSTIFY($PIECE(^(BILLDA),"^",2),20,2))
- End DoDot:1
- +38 ;
- +39 SET XMTEXT="^TMP($J,""RCXFMSTRXMB"","
- +40 SET XMSUB="FMS PRIOR YEAR RECEIVABLES"
- +41 SET XMDUZ="Accounts Receivable Package"
- SET XMY("G.FMS")=""
- SET XMY(DUZ)=""
- +42 DO ^XMD
- +43 ;
- +44 KILL ^TMP($JOB,"RCXFMSTR"),^TMP($JOB,"RCXFMSTRXMB")
- +45 QUIT
- +46 ;
- +47 ;
- SET(STRING) ; set the line for the report
- +1 SET LINE=LINE+1
- SET ^TMP($JOB,"RCXFMSTRXMB",LINE)=STRING
- +2 QUIT