FBFHLX1 ;WOIFO/SAB-TRANSMIT HL7 MESSAGES TO FPPS (CON'T) ;9/9/2003
;;3.5;FEE BASIS;**61,121,122**;JAN 30 1995;Build 8
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
CHKACK ; check for acknowledgements
; input - none
; output
; FBCNT("ACKT") - count of previously transmitted invoices w/o ack
; FBCNT("ACKA") - count of these that were accepted
; FBCNT("ACKR") - count of these that were rejected
; FBCNT("ACKW") - count of these that are still waiting for ack
; ^TMP($J,"FBNA",invoice number)="" - list waiting for ack
; update file 163.5
N FBAAIN,FBMSGID,FBQDA,FBQY,FBSTATUS,FBX
;
; initialize
K ^TMP($J,"FBNA")
F FBX="ACKA","ACKR","ACKW" S FBCNT(FBX)=0
;
; loop thru transmitted (not yet acknowledged entries)
S FBQDA=0 F S FBQDA=$O(^FBHL(163.5,"AC",1,FBQDA)) Q:'FBQDA D
. S ^XTMP("FBFHLX","IEN")=$H_U_FBQDA_"^NYACK^" ; FB*3.5*122
. S FBQY=$G(^FBHL(163.5,FBQDA,0))
. S FBAAIN=$P(FBQY,U)
. Q:FBAAIN="" ; invalid invoice number
. S FBMSGID=$P(FBQY,U,4)
. Q:FBMSGID=""
. ;
. S FBSTATUS=$$MSGSTAT^HLUTIL(FBMSGID)
. ;
. I $P(FBSTATUS,U)=3 D Q
. . N FBFDA
. . S FBFDA(163.5,FBQDA_",",2)="2" ; set status = acknowledged
. . S FBFDA(163.5,FBQDA_",",8)="A" ; set ACK FLAG = ACCEPTED
. . S FBFDA(163.5,FBQDA_",",9)=$P(FBSTATUS,U,2) ; set ACK DATE/TIME
. . I $D(FBFDA) D FILE^DIE("","FBFDA")
. . S FBCNT("ACKA")=FBCNT("ACKA")+1
. ;
. I $P(FBSTATUS,U)=4 D Q
. . N FBFDA,FBTXT
. . S FBFDA(163.5,FBQDA_",",2)="2" ; set status = acknowledged
. . S FBFDA(163.5,FBQDA_",",8)="R" ; set ACK FLAG = rejected
. . S FBFDA(163.5,FBQDA_",",9)=$P(FBSTATUS,U,2) ; set ACK DATE/TIME
. . S FBFDA(163.5,FBQDA_",",10)="N" ; rej status = not reported
. . I $D(FBFDA) D FILE^DIE("","FBFDA")
. . S FBTXT(1)=$P(FBSTATUS,U,3)
. . I FBTXT(1)]"" D WP^DIE(163.5,FBQDA_",",11,"","FBTXT") ; error msg
. . S FBCNT("ACKR")=FBCNT("ACKR")+1
. ;
. ; don't report not acknowledged unless it is last entry for invoice
. Q:$$LAST^FBFHLU($P(FBQY,U))'=FBQDA
. ;
. ; last entry for invoice was not acknowledged yet
. S ^TMP($J,"FBNA",FBAAIN)=""
. S FBCNT("ACKW")=FBCNT("ACKW")+1
;
S FBCNT("ACKT")=FBCNT("ACKA")+FBCNT("ACKR")+FBCNT("ACKW")
;
Q
;
SUMMSG ; Summary Message (build and send)
; input
; ^TMP($J,"FBE",invoice number,seq number)=error text
; ^TMP($J,"FBW",invoice number,seq number)=warning text
; ^TMP($J,"FBNA",invoice number)="" for invoices not acknowledged
; ^TMP($J,"FBX",seq number)=message text so far
; FBXL = last line used in ^TMP($J,"FBX",seq number)
; FBXMIT("START") = start process, FileMan date/time
; FBXMIT("ACK") = start check for acks, FileMan date/time
; FBXMIT("SEND") = start transmit, FileMan date/time
; FBXMIT("END") = end process, FileMan date/time
; FBCNT("PENDT")= count of pending invoices that were transmitted
; FBCNT("PENDE")= count of pending invoices that had exception
; FBCNT("ACKT") = count of previously transmitted invoices w/o ack
; FBCNT("ACKA") = count of these that were accepted
; FBCNT("ACKR") = count of these that were rejected
; FBCNT("ACKW") = count of these that are still waiting for ack
; output
; ^TMP($J,"FBX",
; mail message
;
N XMDUZ,XMSUB,XMTEXT,XMY,XMZ
;
; add header text
S ^TMP($J,"FBX",1)=$$FMTE^XLFDT(FBXMIT("START"))_" Process Started."
S ^TMP($J,"FBX",2)=$$FMTE^XLFDT(FBXMIT("ACK"))_" Check transmitted messages for acknowledgement..."
S ^TMP($J,"FBX",3)=" "_FBCNT("ACKT")_" previously transmitted messages w/o ack."
S ^TMP($J,"FBX",4)=" "_FBCNT("ACKA")_" of these were accepted."
S ^TMP($J,"FBX",5)=" "_FBCNT("ACKR")_" of these were rejected."
S ^TMP($J,"FBX",6)=" "_FBCNT("ACKW")_" of these still waiting for ack."
S ^TMP($J,"FBX",7)=$$FMTE^XLFDT(FBXMIT("SEND"))_" Transmit pending invoices..."
S ^TMP($J,"FBX",8)=" "_FBCNT("PENDT")_" transmitted."
S ^TMP($J,"FBX",9)=" "_FBCNT("PENDE")_" not transmitted due to exception."
S ^TMP($J,"FBX",10)=$$FMTE^XLFDT(FBXMIT("END"))_" Process Complete."
I $D(ZTSTOP) S ^TMP($J,"FBX",11)=" Process (task) stopped due to user request."
I $D(FBCNT("10K")) S ^TMP($J,"FBX",12)=" Process (task) stopped due to reaching 10K message limit." ; FB*3.5*121
;
; List Exceptions
I FBCNT("PENDE")>0 D
. N FBAAIN,FBL,FBX
. D PTXT(.FBXL," ")
. D PTXT(.FBXL,"List of Exceptions during Transmit of Pending Invoices")
. S FBAAIN="" F S FBAAIN=$O(^TMP($J,"FBE",FBAAIN)) Q:FBAAIN="" D
. . D PTXT(.FBXL,"Invoice: "_FBAAIN)
. . S FBL=0 F S FBL=$O(^TMP($J,"FBE",FBAAIN,FBL)) Q:'FBL D
. . . S FBX=$G(^TMP($J,"FBE",FBAAIN,FBL))
. . . I FBX]"" D PTXT(.FBXL," "_FBX)
;
; List Invoices Waiting for Ack
I FBCNT("ACKW")>0 D
. N FBAAIN
. D PTXT(.FBXL," ")
. D PTXT(.FBXL,"List of Invoices Waiting for Acknowledgement")
. S FBAAIN="" F S FBAAIN=$O(^TMP($J,"FBW",FBAAIN)) Q:FBAAIN="" D
. . D PTXT(.FBXL,"Invoice: "_FBAAIN)
;
; Report Rejected Acks
I $D(^FBHL(163.5,"ARS","N")) D
. N FBAAIN,FBFDA,FBI,FBQDA,FBTXT,FBWP,FBX
. D PTXT(.FBXL," ")
. D PTXT(.FBXL,"List of Rejected Invoices that have not been reported.")
. S FBQDA=0 F S FBQDA=$O(^FBHL(163.5,"ARS","N",FBQDA)) Q:'FBQDA D
. . S FBQY=$G(^FBHL(163.5,FBQDA,0))
. . S FBAAIN=$P(FBQY,U)
. . D PTXT(.FBXL,"Invoice: "_FBAAIN)
. . ;
. . K FBWP
. . S FBX=$$GET1^DIQ(163.5,FBQDA_",",11,"","FBWP")
. . S FBI=0 F S FBI=$O(FBWP(FBI)) Q:'FBI D
. . . S FBTXT=FBWP(FBI)
. . . D PTXT(.FBXL," "_FBTXT)
. . ;
. . K FBFDA
. . S FBFDA(163,FBQDA_",",10)="R" ; set reject status = reported
. . I $D(FBFDA) D FILE^DIE("","FBFDA")
;
D PTXT(.FBXL," ")
D PTXT(.FBXL,"END OF SUMMARY MESSAGE")
;
; send message
S XMSUB="FEE BASIS FPPS Transmit "_$$FMTE^XLFDT(FBXMIT("START"),"DF")
S XMDUZ="FEE BASIS"
S XMY("G.FEE")=""
S XMTEXT="^TMP($J,""FBX"","
D ^XMD
Q
;
PTXT(FBXL,FBTXT) ; Post line of text in global array for summary message
; input
; FBXL - last line number used, passed by reference
; FBTXT - line of text
; output
; FBXL - increments value by 1
; ^TMP($J,"FBX",input line+1)=text
;
S FBXL=FBXL+1
S ^TMP($J,"FBX",FBXL)=FBTXT
;
Q
;
;FBFHLX1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBFHLX1 6371 printed Sep 23, 2025@19:34:30 Page 2
FBFHLX1 ;WOIFO/SAB-TRANSMIT HL7 MESSAGES TO FPPS (CON'T) ;9/9/2003
+1 ;;3.5;FEE BASIS;**61,121,122**;JAN 30 1995;Build 8
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
CHKACK ; check for acknowledgements
+1 ; input - none
+2 ; output
+3 ; FBCNT("ACKT") - count of previously transmitted invoices w/o ack
+4 ; FBCNT("ACKA") - count of these that were accepted
+5 ; FBCNT("ACKR") - count of these that were rejected
+6 ; FBCNT("ACKW") - count of these that are still waiting for ack
+7 ; ^TMP($J,"FBNA",invoice number)="" - list waiting for ack
+8 ; update file 163.5
+9 NEW FBAAIN,FBMSGID,FBQDA,FBQY,FBSTATUS,FBX
+10 ;
+11 ; initialize
+12 KILL ^TMP($JOB,"FBNA")
+13 FOR FBX="ACKA","ACKR","ACKW"
SET FBCNT(FBX)=0
+14 ;
+15 ; loop thru transmitted (not yet acknowledged entries)
+16 SET FBQDA=0
FOR
SET FBQDA=$ORDER(^FBHL(163.5,"AC",1,FBQDA))
if 'FBQDA
QUIT
Begin DoDot:1
+17 ; FB*3.5*122
SET ^XTMP("FBFHLX","IEN")=$HOROLOG_U_FBQDA_"^NYACK^"
+18 SET FBQY=$GET(^FBHL(163.5,FBQDA,0))
+19 SET FBAAIN=$PIECE(FBQY,U)
+20 ; invalid invoice number
if FBAAIN=""
QUIT
+21 SET FBMSGID=$PIECE(FBQY,U,4)
+22 if FBMSGID=""
QUIT
+23 ;
+24 SET FBSTATUS=$$MSGSTAT^HLUTIL(FBMSGID)
+25 ;
+26 IF $PIECE(FBSTATUS,U)=3
Begin DoDot:2
+27 NEW FBFDA
+28 ; set status = acknowledged
SET FBFDA(163.5,FBQDA_",",2)="2"
+29 ; set ACK FLAG = ACCEPTED
SET FBFDA(163.5,FBQDA_",",8)="A"
+30 ; set ACK DATE/TIME
SET FBFDA(163.5,FBQDA_",",9)=$PIECE(FBSTATUS,U,2)
+31 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+32 SET FBCNT("ACKA")=FBCNT("ACKA")+1
End DoDot:2
QUIT
+33 ;
+34 IF $PIECE(FBSTATUS,U)=4
Begin DoDot:2
+35 NEW FBFDA,FBTXT
+36 ; set status = acknowledged
SET FBFDA(163.5,FBQDA_",",2)="2"
+37 ; set ACK FLAG = rejected
SET FBFDA(163.5,FBQDA_",",8)="R"
+38 ; set ACK DATE/TIME
SET FBFDA(163.5,FBQDA_",",9)=$PIECE(FBSTATUS,U,2)
+39 ; rej status = not reported
SET FBFDA(163.5,FBQDA_",",10)="N"
+40 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+41 SET FBTXT(1)=$PIECE(FBSTATUS,U,3)
+42 ; error msg
IF FBTXT(1)]""
DO WP^DIE(163.5,FBQDA_",",11,"","FBTXT")
+43 SET FBCNT("ACKR")=FBCNT("ACKR")+1
End DoDot:2
QUIT
+44 ;
+45 ; don't report not acknowledged unless it is last entry for invoice
+46 if $$LAST^FBFHLU($PIECE(FBQY,U))'=FBQDA
QUIT
+47 ;
+48 ; last entry for invoice was not acknowledged yet
+49 SET ^TMP($JOB,"FBNA",FBAAIN)=""
+50 SET FBCNT("ACKW")=FBCNT("ACKW")+1
End DoDot:1
+51 ;
+52 SET FBCNT("ACKT")=FBCNT("ACKA")+FBCNT("ACKR")+FBCNT("ACKW")
+53 ;
+54 QUIT
+55 ;
SUMMSG ; Summary Message (build and send)
+1 ; input
+2 ; ^TMP($J,"FBE",invoice number,seq number)=error text
+3 ; ^TMP($J,"FBW",invoice number,seq number)=warning text
+4 ; ^TMP($J,"FBNA",invoice number)="" for invoices not acknowledged
+5 ; ^TMP($J,"FBX",seq number)=message text so far
+6 ; FBXL = last line used in ^TMP($J,"FBX",seq number)
+7 ; FBXMIT("START") = start process, FileMan date/time
+8 ; FBXMIT("ACK") = start check for acks, FileMan date/time
+9 ; FBXMIT("SEND") = start transmit, FileMan date/time
+10 ; FBXMIT("END") = end process, FileMan date/time
+11 ; FBCNT("PENDT")= count of pending invoices that were transmitted
+12 ; FBCNT("PENDE")= count of pending invoices that had exception
+13 ; FBCNT("ACKT") = count of previously transmitted invoices w/o ack
+14 ; FBCNT("ACKA") = count of these that were accepted
+15 ; FBCNT("ACKR") = count of these that were rejected
+16 ; FBCNT("ACKW") = count of these that are still waiting for ack
+17 ; output
+18 ; ^TMP($J,"FBX",
+19 ; mail message
+20 ;
+21 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+22 ;
+23 ; add header text
+24 SET ^TMP($JOB,"FBX",1)=$$FMTE^XLFDT(FBXMIT("START"))_" Process Started."
+25 SET ^TMP($JOB,"FBX",2)=$$FMTE^XLFDT(FBXMIT("ACK"))_" Check transmitted messages for acknowledgement..."
+26 SET ^TMP($JOB,"FBX",3)=" "_FBCNT("ACKT")_" previously transmitted messages w/o ack."
+27 SET ^TMP($JOB,"FBX",4)=" "_FBCNT("ACKA")_" of these were accepted."
+28 SET ^TMP($JOB,"FBX",5)=" "_FBCNT("ACKR")_" of these were rejected."
+29 SET ^TMP($JOB,"FBX",6)=" "_FBCNT("ACKW")_" of these still waiting for ack."
+30 SET ^TMP($JOB,"FBX",7)=$$FMTE^XLFDT(FBXMIT("SEND"))_" Transmit pending invoices..."
+31 SET ^TMP($JOB,"FBX",8)=" "_FBCNT("PENDT")_" transmitted."
+32 SET ^TMP($JOB,"FBX",9)=" "_FBCNT("PENDE")_" not transmitted due to exception."
+33 SET ^TMP($JOB,"FBX",10)=$$FMTE^XLFDT(FBXMIT("END"))_" Process Complete."
+34 IF $DATA(ZTSTOP)
SET ^TMP($JOB,"FBX",11)=" Process (task) stopped due to user request."
+35 ; FB*3.5*121
IF $DATA(FBCNT("10K"))
SET ^TMP($JOB,"FBX",12)=" Process (task) stopped due to reaching 10K message limit."
+36 ;
+37 ; List Exceptions
+38 IF FBCNT("PENDE")>0
Begin DoDot:1
+39 NEW FBAAIN,FBL,FBX
+40 DO PTXT(.FBXL," ")
+41 DO PTXT(.FBXL,"List of Exceptions during Transmit of Pending Invoices")
+42 SET FBAAIN=""
FOR
SET FBAAIN=$ORDER(^TMP($JOB,"FBE",FBAAIN))
if FBAAIN=""
QUIT
Begin DoDot:2
+43 DO PTXT(.FBXL,"Invoice: "_FBAAIN)
+44 SET FBL=0
FOR
SET FBL=$ORDER(^TMP($JOB,"FBE",FBAAIN,FBL))
if 'FBL
QUIT
Begin DoDot:3
+45 SET FBX=$GET(^TMP($JOB,"FBE",FBAAIN,FBL))
+46 IF FBX]""
DO PTXT(.FBXL," "_FBX)
End DoDot:3
End DoDot:2
End DoDot:1
+47 ;
+48 ; List Invoices Waiting for Ack
+49 IF FBCNT("ACKW")>0
Begin DoDot:1
+50 NEW FBAAIN
+51 DO PTXT(.FBXL," ")
+52 DO PTXT(.FBXL,"List of Invoices Waiting for Acknowledgement")
+53 SET FBAAIN=""
FOR
SET FBAAIN=$ORDER(^TMP($JOB,"FBW",FBAAIN))
if FBAAIN=""
QUIT
Begin DoDot:2
+54 DO PTXT(.FBXL,"Invoice: "_FBAAIN)
End DoDot:2
End DoDot:1
+55 ;
+56 ; Report Rejected Acks
+57 IF $DATA(^FBHL(163.5,"ARS","N"))
Begin DoDot:1
+58 NEW FBAAIN,FBFDA,FBI,FBQDA,FBTXT,FBWP,FBX
+59 DO PTXT(.FBXL," ")
+60 DO PTXT(.FBXL,"List of Rejected Invoices that have not been reported.")
+61 SET FBQDA=0
FOR
SET FBQDA=$ORDER(^FBHL(163.5,"ARS","N",FBQDA))
if 'FBQDA
QUIT
Begin DoDot:2
+62 SET FBQY=$GET(^FBHL(163.5,FBQDA,0))
+63 SET FBAAIN=$PIECE(FBQY,U)
+64 DO PTXT(.FBXL,"Invoice: "_FBAAIN)
+65 ;
+66 KILL FBWP
+67 SET FBX=$$GET1^DIQ(163.5,FBQDA_",",11,"","FBWP")
+68 SET FBI=0
FOR
SET FBI=$ORDER(FBWP(FBI))
if 'FBI
QUIT
Begin DoDot:3
+69 SET FBTXT=FBWP(FBI)
+70 DO PTXT(.FBXL," "_FBTXT)
End DoDot:3
+71 ;
+72 KILL FBFDA
+73 ; set reject status = reported
SET FBFDA(163,FBQDA_",",10)="R"
+74 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
End DoDot:2
End DoDot:1
+75 ;
+76 DO PTXT(.FBXL," ")
+77 DO PTXT(.FBXL,"END OF SUMMARY MESSAGE")
+78 ;
+79 ; send message
+80 SET XMSUB="FEE BASIS FPPS Transmit "_$$FMTE^XLFDT(FBXMIT("START"),"DF")
+81 SET XMDUZ="FEE BASIS"
+82 SET XMY("G.FEE")=""
+83 SET XMTEXT="^TMP($J,""FBX"","
+84 DO ^XMD
+85 QUIT
+86 ;
PTXT(FBXL,FBTXT) ; Post line of text in global array for summary message
+1 ; input
+2 ; FBXL - last line number used, passed by reference
+3 ; FBTXT - line of text
+4 ; output
+5 ; FBXL - increments value by 1
+6 ; ^TMP($J,"FBX",input line+1)=text
+7 ;
+8 SET FBXL=FBXL+1
+9 SET ^TMP($JOB,"FBX",FBXL)=FBTXT
+10 ;
+11 QUIT
+12 ;
+13 ;FBFHLX1
