Routine: FBMON

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.

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")

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)

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

 ;  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

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  Feb 18, 2025@23:25:03                                                                                                                                                                                                       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

FBMON.m