FBMON ;DSS/LJF - VISTA FEE 5010 UPGRADE ;4/4/2011
;;3.5;FEE BASIS;**122**;JAN 30, 1995;Build 8
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
INIT() ; Standard data items
; N FBFENFLD,FBFPARIX,FBFPROOT,FBFSTFLD,FBFINTER ; set by $$INIT
I $E($G(IOST),1,2)="C-" S FBFINTER=1 ; interactive flag
S FBFSTFLD=36,FBFENFLD=37,FBFPROOT=161.4,FBFPARIX=$O(^FBAA(FBFPROOT,0))_"," I 'FBFPARIX Q 0 ; FBFPARIX EG: "1234,"
Q 1
;
EN ; OPTION "FB FPPS MONITOR" entry point
N FBFSTAT
S ZTSK=+$G(ZTSK)
I 'ZTSK D FOREGRND Q
; background process
S FBFSTAT=$$FACTIVE(.FBFSTAT)
I FBFSTAT("STATE")'="STALLED 2+ HOURS",FBFSTAT("STATE")'="STALLED 50+ HOURS" Q
D REPORTIT(.FBFSTAT) K ^XTMP("FBFHLX")
Q
;
FOREGRND ;
N FBFSTAT
S FBFSTAT=$$FACTIVE(.FBFSTAT)
I FBFSTAT("STATE")="INACTIVE" D INFORM(2,FBFSTAT("START"),FBFSTAT("END"),FBFSTAT("STATE"),,,,,,FBFSTAT) Q
I FBFSTAT("STATE")="ACTIVE" D INFORM(3,FBFSTAT("START"),FBFSTAT("END"),FBFSTAT("STATE"),FBFSTAT("UPDATE"),FBFSTAT("IEN"),,,,FBFSTAT) Q
I FBFSTAT("STATE")="STALLED 50+ HOURS" D INFORM(4,FBFSTAT("START"),FBFSTAT("END"),FBFSTAT("STATE"),,,,,,FBFSTAT) Q
I FBFSTAT("STATE")="STALLED 2+ HOURS" D INFORM(3,FBFSTAT("START"),FBFSTAT("END"),FBFSTAT("STATE"),FBFSTAT("UPDATE"),FBFSTAT("IEN"),,,,FBFSTAT) Q
D INFORM(,FBFSTAT("START"),FBFSTAT("END"),FBFSTAT("STATE"),FBFSTAT("UPDATE"),FBFSTAT("IEN"),,,,FBFSTAT)
Q
;
FACTIVE(FBFRET) ; Return active/inactive flag
N FBFDIFF,FBFXDA
S FBFRET="0^INACTIVE",FBFRET("STATE")="INACTIVE",(FBFRET("START"),FBFRET("UPDATE"),FBFRET("END"),FBFRET("IEN"))=""
I '$$INIT Q
D GETS^DIQ(FBFPROOT,FBFPARIX,FBFSTFLD_";"_FBFENFLD,"I","FBFXDA")
S FBFRET("START")=FBFXDA(FBFPROOT,FBFPARIX,FBFSTFLD,"I"),FBFRET("END")=FBFXDA(FBFPROOT,FBFPARIX,FBFENFLD,"I")
; S^XTMP("FBFHLX","IEN")=$H_U_IEN_"^XMIT^"
S FBFRET("UPDATE")=$G(^XTMP("FBFHLX","IEN")),FBFRET("IEN")=$P(FBFRET("UPDATE"),U,2),FBFRET("UPDATE")=$P(FBFRET("UPDATE"),U)
I FBFRET("UPDATE") S FBFRET("UPDATE")=$$HTFM^XLFDT(FBFRET("UPDATE"))
I $$FMDIFF^XLFDT($$NOW^XLFDT,+FBFRET("START"),2)>180000 S FBFRET("STATE")="STALLED 50+ HOURS",FBFRET="0^STALLED 50+ HOURS" Q FBFRET ; 50 hours okay to start
;
I FBFRET("END")'<FBFRET("START") Q FBFRET
I 'FBFRET("UPDATE"),FBFRET("END")'<FBFRET("START") Q FBFRET ; no active FB FPPS TRANSMIT
;
I FBFRET("UPDATE"),$$FMDIFF^XLFDT($$NOW^XLFDT,+FBFRET("UPDATE"),2)\3600 S FBFRET("STATE")="STALLED 2+ HOURS",FBFRET="1^STALLED" Q FBFRET
S FBFRET="1^ACTIVE",FBFRET("STATE")="ACTIVE"
Q FBFRET
;
REPORTIT(FBFARG1) ;
; ;FBFARG1
N XMSUB,XMDUZ,XMY,MTEXT,XMTEXT,FBMG,FBMG1
S FBFARG1="FEE5010",FBFARG1("START")=$G(FBFARG1("START")),FBFARG1("END")=$G(FBFARG1("END"))
S FBFARG1("UPDATE")=$G(FBFARG1("UPDATE")),FBFARG1("IEN")=$G(FBFARG1("IEN")),FBFARG1("STATE")=$G(FBFARG1("STATE"))
K ^TMP($J,FBFARG1)
S ^TMP($J,FBFARG1,1)=" ** FB FPPS MONITOR **"
S ^TMP($J,FBFARG1,2)=""
S ^TMP($J,FBFARG1,3)=" Current date: "_$$FMTE^XLFDT($$NOW^XLFDT)
S ^TMP($J,FBFARG1,4)=""
S ^TMP($J,FBFARG1,5)=" The FB FPPS TRANSMIT option has not run."
S ^TMP($J,FBFARG1,6)=" Last started: "_$$FMTE^XLFDT(FBFARG1("START"))
S ^TMP($J,FBFARG1,7)=" Last completed: "_$$FMTE^XLFDT(FBFARG1("END"))
S ^TMP($J,FBFARG1,8)=" Last update: "_$$FMTE^XLFDT(FBFARG1("UPDATE"))
S ^TMP($J,FBFARG1,9)=" Last record processed: "_FBFARG1("IEN")
S ^TMP($J,FBFARG1,10)=" The current status is: "_FBFARG1("STATE")
S ^TMP($J,FBFARG1,11)=""
S ^TMP($J,FBFARG1,12)=" Please check the FB FPPS TRANSMIT option for scheduling issues or errors."
;
S XMSUB="FEE BASIS FPPS Transmit Issue"
S XMDUZ=.5
S XMY("G.FEE")=""
S XMTEXT="^TMP($J,"""_FBFARG1_""","
D ^XMD
K ^TMP($J,FBFARG1)
;
S ^TMP($J,FBFARG1,1)="Site: "_$TR($P($$SITE^VASITE,U,1,2),U," ")
S ^TMP($J,FBFARG1,2)=""
S ^TMP($J,FBFARG1,3)="Current date: "_$$FMTE^XLFDT($$NOW^XLFDT)
S ^TMP($J,FBFARG1,4)="The FB FPPS TRANSMIT option has not run."
S ^TMP($J,FBFARG1,5)="The last completed transmission was on "_$$FMTE^XLFDT(FBFARG1("END"))
S ^TMP($J,FBFARG1,6)=""
S ^TMP($J,FBFARG1,7)="Local site recipients of this message are:"
D FIND^DIC(3.8,,"@;.01","BOX","FEE",1,"B",,,"FBMG")
I $G(FBMG("DILIST","2",1)) D GETS^DIQ(3.8,FBMG("DILIST","2",1),"2*","IN","FBMG1") S XMDUZ=0 F S XMDUZ=$O(FBMG1("3.81",XMDUZ)) Q:XMDUZ="" D
. S XMSUB=$$GET1^DIQ(200,+FBMG1("3.81",XMDUZ,".01","I"),.01)
. I XMSUB]"" S ^TMP($J,FBFARG1,"7."_+FBMG1("3.81",XMDUZ,".01","I"))=XMSUB
S ^TMP($J,FBFARG1,8)=""
S ^TMP($J,FBFARG1,9)=""
S ^TMP($J,FBFARG1,10)="Please contact the local site for scheduling issues or errors with this option."
;
S XMSUB="FPPS Transmit Issue "_$P($$SITE^VASITE,U,2)
S XMDUZ=.5
S XMY("Fee.EDI_Issues@domain.ext")=""
S XMTEXT="^TMP($J,"""_FBFARG1_""","
D ^XMD
Q
;
; FBFARG1 .eqs. message to display FBFARG2...FBFARGn .eqs. arguments for particular display
INFORM(FBFARG1,FBFARG2,FBFARG3,FBFARG4,FBFARG5,FBFARG6,FBFARG7,FBFARG8,FBFARG9,FBFARG10) ;
N DIR,DIRUT,X,Y
S FBFARG1=$G(FBFARG1),FBFARG2=$G(FBFARG2),FBFARG3=$G(FBFARG3),FBFARG4=$G(FBFARG4),FBFARG5=$G(FBFARG5)
S FBFARG6=$G(FBFARG6),FBFARG7=$G(FBFARG7),FBFARG8=$G(FBFARG8),FBFARG9=$G(FBFARG9),FBFARG10=$G(FBFARG10)
S DIR("A")="Press return to continue"
S DIR(0)="FO"
S DIR("A",.1)=""
S DIR("A",.11)=" -------------------------------------------------"
S DIR("A",.12)=""
S DIR("A",.2)=" ** FB FPPS MONITOR **"
S DIR("A",.3)=""
S DIR("A",.4)=" The current time is: "_$$FMTE^XLFDT($$NOW^XLFDT)
S DIR("A",.5)=""
S DIR("A",.6)=""
S DIR("A",.7)=" 'FB FPPS TRANSMIT' started: "_$$FMTE^XLFDT(FBFARG2)
S DIR("A",.8)=" 'FB FPPS TRANSMIT' ended: "_$$FMTE^XLFDT(FBFARG3)
S DIR("A",.9)=""
S DIR("A",1)=" The current status is: "_$S(FBFARG4="INACTIVE":"COMPLETED SUCCESSFULLY, NOT CURRENTLY RUNNING",FBFARG4="ACTIVE":"RUNNING",1:FBFARG4)
S DIR("A",2)=""
D ^DIR K DIR
Q
;
SETH(X) ; Fileman date input, returns $H value
N %H
D H^XLFDT
Q %H
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBMON 6048 printed Apr 09, 2024@21:04:51 Page 2
FBMON ;DSS/LJF - VISTA FEE 5010 UPGRADE ;4/4/2011
+1 ;;3.5;FEE BASIS;**122**;JAN 30, 1995;Build 8
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
INIT() ; Standard data items
+1 ; N FBFENFLD,FBFPARIX,FBFPROOT,FBFSTFLD,FBFINTER ; set by $$INIT
+2 ; interactive flag
IF $EXTRACT($GET(IOST),1,2)="C-"
SET FBFINTER=1
+3 ; FBFPARIX EG: "1234,"
SET FBFSTFLD=36
SET FBFENFLD=37
SET FBFPROOT=161.4
SET FBFPARIX=$ORDER(^FBAA(FBFPROOT,0))_","
IF 'FBFPARIX
QUIT 0
+4 QUIT 1
+5 ;
EN ; OPTION "FB FPPS MONITOR" entry point
+1 NEW FBFSTAT
+2 SET ZTSK=+$GET(ZTSK)
+3 IF 'ZTSK
DO FOREGRND
QUIT
+4 ; background process
+5 SET FBFSTAT=$$FACTIVE(.FBFSTAT)
+6 IF FBFSTAT("STATE")'="STALLED 2+ HOURS"
IF FBFSTAT("STATE")'="STALLED 50+ HOURS"
QUIT
+7 DO REPORTIT(.FBFSTAT)
KILL ^XTMP("FBFHLX")
+8 QUIT
+9 ;
FOREGRND ;
+1 NEW FBFSTAT
+2 SET FBFSTAT=$$FACTIVE(.FBFSTAT)
+3 IF FBFSTAT("STATE")="INACTIVE"
DO INFORM(2,FBFSTAT("START"),FBFSTAT("END"),FBFSTAT("STATE"),,,,,,FBFSTAT)
QUIT
+4 IF FBFSTAT("STATE")="ACTIVE"
DO INFORM(3,FBFSTAT("START"),FBFSTAT("END"),FBFSTAT("STATE"),FBFSTAT("UPDATE"),FBFSTAT("IEN"),,,,FBFSTAT)
QUIT
+5 IF FBFSTAT("STATE")="STALLED 50+ HOURS"
DO INFORM(4,FBFSTAT("START"),FBFSTAT("END"),FBFSTAT("STATE"),,,,,,FBFSTAT)
QUIT
+6 IF FBFSTAT("STATE")="STALLED 2+ HOURS"
DO INFORM(3,FBFSTAT("START"),FBFSTAT("END"),FBFSTAT("STATE"),FBFSTAT("UPDATE"),FBFSTAT("IEN"),,,,FBFSTAT)
QUIT
+7 DO INFORM(,FBFSTAT("START"),FBFSTAT("END"),FBFSTAT("STATE"),FBFSTAT("UPDATE"),FBFSTAT("IEN"),,,,FBFSTAT)
+8 QUIT
+9 ;
FACTIVE(FBFRET) ; Return active/inactive flag
+1 NEW FBFDIFF,FBFXDA
+2 SET FBFRET="0^INACTIVE"
SET FBFRET("STATE")="INACTIVE"
SET (FBFRET("START"),FBFRET("UPDATE"),FBFRET("END"),FBFRET("IEN"))=""
+3 IF '$$INIT
QUIT
+4 DO GETS^DIQ(FBFPROOT,FBFPARIX,FBFSTFLD_";"_FBFENFLD,"I","FBFXDA")
+5 SET FBFRET("START")=FBFXDA(FBFPROOT,FBFPARIX,FBFSTFLD,"I")
SET FBFRET("END")=FBFXDA(FBFPROOT,FBFPARIX,FBFENFLD,"I")
+6 ; S^XTMP("FBFHLX","IEN")=$H_U_IEN_"^XMIT^"
+7 SET FBFRET("UPDATE")=$GET(^XTMP("FBFHLX","IEN"))
SET FBFRET("IEN")=$PIECE(FBFRET("UPDATE"),U,2)
SET FBFRET("UPDATE")=$PIECE(FBFRET("UPDATE"),U)
+8 IF FBFRET("UPDATE")
SET FBFRET("UPDATE")=$$HTFM^XLFDT(FBFRET("UPDATE"))
+9 ; 50 hours okay to start
IF $$FMDIFF^XLFDT($$NOW^XLFDT,+FBFRET("START"),2)>180000
SET FBFRET("STATE")="STALLED 50+ HOURS"
SET FBFRET="0^STALLED 50+ HOURS"
QUIT FBFRET
+10 ;
+11 IF FBFRET("END")'<FBFRET("START")
QUIT FBFRET
+12 ; no active FB FPPS TRANSMIT
IF 'FBFRET("UPDATE")
IF FBFRET("END")'<FBFRET("START")
QUIT FBFRET
+13 ;
+14 IF FBFRET("UPDATE")
IF $$FMDIFF^XLFDT($$NOW^XLFDT,+FBFRET("UPDATE"),2)\3600
SET FBFRET("STATE")="STALLED 2+ HOURS"
SET FBFRET="1^STALLED"
QUIT FBFRET
+15 SET FBFRET="1^ACTIVE"
SET FBFRET("STATE")="ACTIVE"
+16 QUIT FBFRET
+17 ;
REPORTIT(FBFARG1) ;
+1 ; ;FBFARG1
+2 NEW XMSUB,XMDUZ,XMY,MTEXT,XMTEXT,FBMG,FBMG1
+3 SET FBFARG1="FEE5010"
SET FBFARG1("START")=$GET(FBFARG1("START"))
SET FBFARG1("END")=$GET(FBFARG1("END"))
+4 SET FBFARG1("UPDATE")=$GET(FBFARG1("UPDATE"))
SET FBFARG1("IEN")=$GET(FBFARG1("IEN"))
SET FBFARG1("STATE")=$GET(FBFARG1("STATE"))
+5 KILL ^TMP($JOB,FBFARG1)
+6 SET ^TMP($JOB,FBFARG1,1)=" ** FB FPPS MONITOR **"
+7 SET ^TMP($JOB,FBFARG1,2)=""
+8 SET ^TMP($JOB,FBFARG1,3)=" Current date: "_$$FMTE^XLFDT($$NOW^XLFDT)
+9 SET ^TMP($JOB,FBFARG1,4)=""
+10 SET ^TMP($JOB,FBFARG1,5)=" The FB FPPS TRANSMIT option has not run."
+11 SET ^TMP($JOB,FBFARG1,6)=" Last started: "_$$FMTE^XLFDT(FBFARG1("START"))
+12 SET ^TMP($JOB,FBFARG1,7)=" Last completed: "_$$FMTE^XLFDT(FBFARG1("END"))
+13 SET ^TMP($JOB,FBFARG1,8)=" Last update: "_$$FMTE^XLFDT(FBFARG1("UPDATE"))
+14 SET ^TMP($JOB,FBFARG1,9)=" Last record processed: "_FBFARG1("IEN")
+15 SET ^TMP($JOB,FBFARG1,10)=" The current status is: "_FBFARG1("STATE")
+16 SET ^TMP($JOB,FBFARG1,11)=""
+17 SET ^TMP($JOB,FBFARG1,12)=" Please check the FB FPPS TRANSMIT option for scheduling issues or errors."
+18 ;
+19 SET XMSUB="FEE BASIS FPPS Transmit Issue"
+20 SET XMDUZ=.5
+21 SET XMY("G.FEE")=""
+22 SET XMTEXT="^TMP($J,"""_FBFARG1_""","
+23 DO ^XMD
+24 KILL ^TMP($JOB,FBFARG1)
+25 ;
+26 SET ^TMP($JOB,FBFARG1,1)="Site: "_$TRANSLATE($PIECE($$SITE^VASITE,U,1,2),U," ")
+27 SET ^TMP($JOB,FBFARG1,2)=""
+28 SET ^TMP($JOB,FBFARG1,3)="Current date: "_$$FMTE^XLFDT($$NOW^XLFDT)
+29 SET ^TMP($JOB,FBFARG1,4)="The FB FPPS TRANSMIT option has not run."
+30 SET ^TMP($JOB,FBFARG1,5)="The last completed transmission was on "_$$FMTE^XLFDT(FBFARG1("END"))
+31 SET ^TMP($JOB,FBFARG1,6)=""
+32 SET ^TMP($JOB,FBFARG1,7)="Local site recipients of this message are:"
+33 DO FIND^DIC(3.8,,"@;.01","BOX","FEE",1,"B",,,"FBMG")
+34 IF $GET(FBMG("DILIST","2",1))
DO GETS^DIQ(3.8,FBMG("DILIST","2",1),"2*","IN","FBMG1")
SET XMDUZ=0
FOR
SET XMDUZ=$ORDER(FBMG1("3.81",XMDUZ))
if XMDUZ=""
QUIT
Begin DoDot:1
+35 SET XMSUB=$$GET1^DIQ(200,+FBMG1("3.81",XMDUZ,".01","I"),.01)
+36 IF XMSUB]""
SET ^TMP($JOB,FBFARG1,"7."_+FBMG1("3.81",XMDUZ,".01","I"))=XMSUB
End DoDot:1
+37 SET ^TMP($JOB,FBFARG1,8)=""
+38 SET ^TMP($JOB,FBFARG1,9)=""
+39 SET ^TMP($JOB,FBFARG1,10)="Please contact the local site for scheduling issues or errors with this option."
+40 ;
+41 SET XMSUB="FPPS Transmit Issue "_$PIECE($$SITE^VASITE,U,2)
+42 SET XMDUZ=.5
+43 SET XMY("Fee.EDI_Issues@domain.ext")=""
+44 SET XMTEXT="^TMP($J,"""_FBFARG1_""","
+45 DO ^XMD
+46 QUIT
+47 ;
+48 ; FBFARG1 .eqs. message to display FBFARG2...FBFARGn .eqs. arguments for particular display
INFORM(FBFARG1,FBFARG2,FBFARG3,FBFARG4,FBFARG5,FBFARG6,FBFARG7,FBFARG8,FBFARG9,FBFARG10) ;
+1 NEW DIR,DIRUT,X,Y
+2 SET FBFARG1=$GET(FBFARG1)
SET FBFARG2=$GET(FBFARG2)
SET FBFARG3=$GET(FBFARG3)
SET FBFARG4=$GET(FBFARG4)
SET FBFARG5=$GET(FBFARG5)
+3 SET FBFARG6=$GET(FBFARG6)
SET FBFARG7=$GET(FBFARG7)
SET FBFARG8=$GET(FBFARG8)
SET FBFARG9=$GET(FBFARG9)
SET FBFARG10=$GET(FBFARG10)
+4 SET DIR("A")="Press return to continue"
+5 SET DIR(0)="FO"
+6 SET DIR("A",.1)=""
+7 SET DIR("A",.11)=" -------------------------------------------------"
+8 SET DIR("A",.12)=""
+9 SET DIR("A",.2)=" ** FB FPPS MONITOR **"
+10 SET DIR("A",.3)=""
+11 SET DIR("A",.4)=" The current time is: "_$$FMTE^XLFDT($$NOW^XLFDT)
+12 SET DIR("A",.5)=""
+13 SET DIR("A",.6)=""
+14 SET DIR("A",.7)=" 'FB FPPS TRANSMIT' started: "_$$FMTE^XLFDT(FBFARG2)
+15 SET DIR("A",.8)=" 'FB FPPS TRANSMIT' ended: "_$$FMTE^XLFDT(FBFARG3)
+16 SET DIR("A",.9)=""
+17 SET DIR("A",1)=" The current status is: "_$SELECT(FBFARG4="INACTIVE":"COMPLETED SUCCESSFULLY, NOT CURRENTLY RUNNING",FBFARG4="ACTIVE":"RUNNING",1:FBFARG4)
+18 SET DIR("A",2)=""
+19 DO ^DIR
KILL DIR
+20 QUIT
+21 ;
SETH(X) ; Fileman date input, returns $H value
+1 NEW %H
+2 DO H^XLFDT
+3 QUIT %H
