- 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 Feb 18, 2025@23:24:51 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