RGMTMONT ;BIR/CML,PTD-MPI/PD Monitor HL7 Messaging/Filers and Setups ;6/25/20 15:14
;;1.0;CLINICAL INFO RESOURCE NETWORK;**20,30,31,34,75,78**;30 Apr 99;Build 1
;
;Reference to PROTOCOL (#101) file supported by IA #5567
;Reference to OPTION (#19) file supported by IA #10075
;Reference to OPTION SCHEDULING (#19.2) file supported by IA #3599
;Reference to ^DPT("AICNL" supported by IA #2070
;Reference to $$SEND^VAFHUTL for file DG(43 supported by IA #2624
;Reference to ^HLCS(870 supported by IA #3335
;Reference to $$STAT^HLCSLM supported by IA #3574
;Reference to ^DIA(2 and data derived from the AUDIT file (#1.1)
; supported by IA #2097 and #2602.
;Reference to ^XTV(8933.1 supported by IA #7177
;Reference to ^XTV(8989.3 supported by IA #7183
;
EN1 ;Call this routine from the top to do extended checks that include:
;- D HLMA1^RGMTUT98
;- D EN2^RGMTMONT
;- D ^RGMTMONX
;
I $D(RGHLMQ) Q
;
S DEV=0,EN=1 G START
;
DEV ;call used by developers to display ^RGMTMONX call
S DEV=1,EN=2
;
START ;
S CLUP=1
W @IOF,"Logical Link Monitor:",!,"=====================",!
D HLMA1^RGMTUT98
S DIR(0)="E" D D ^DIR K DIR
.S SS=22-$Y F JJ=1:1:SS W !
I $D(DIRUT) G QUIT
;
D EN2
S DIR(0)="E" D D ^DIR K DIR
.S SS=22-$Y F JJ=1:1:SS W !
I $D(DIRUT) G QUIT
;
I $G(EN)'=1 D ^RGMTMONX
;
K EN,DEV G QUIT
;
EN2 ;Monitor Background Job - VAFC BATCH UPDATE
;Monitor Background Job - MPIF LOC/MIS ICN RES
;Check MAS PARAMETER file, field SEND PIMS HL7 V2.3 MESSAGES
;if call is being made from HL7 query, variable RGHLMQ will be defined
S ^XTMP("RGMT",0)=$$FMADD^XLFDT(DT,30)_"^"_$$NOW^XLFDT_"^MPI/PD Maintenance Data"
K ^XTMP("RGMT","HLMQMONT")
I '$D(DEV) S DEV=0
S LOCSITE=$P($$SITE^VASITE(),"^",3)
I $D(RGHLMQ) D
.D NOW^%DTC
.S ^XTMP("RGMT","HLMQMONT",LOCSITE,"@@ RUNDATE")=$$FMTE^XLFDT($E(%,1,12))
I '$D(RGHLMQ) W @IOF,"MPI/PD Process Monitor:",!,"======================="
S TXTCNT=0
N BKDA,CUR,MSG,SCHDA,SEND,TIME
CHK1 ;
S TXT="Checking VAFC BATCH UPDATE background job..." D TXT
D PIV^RGMTUT98
S TXTCNT=3
;
S DIC="^DIC(19,",X="VAFC BATCH UPDATE" D ^DIC K DIC S BKDA=+Y
I BKDA<0 S TXT="=> VAFC BATCH UPDATE does not exist in OPTION file." D TXT K BKDA G CHK2
S TXT="=> VAFC BATCH UPDATE is not currently scheduled to run."
S DIC="^DIC(19.2,",X="VAFC BATCH UPDATE" D ^DIC K DIC S SCHDA=+Y
I SCHDA<0 D TXT K BKDA,TXT,SCHDA G CHK2
S TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
I TIME="" D TXT K BKDA,TXT,SCHDA,TIME G CHK2
S TXT="=> VAFC BATCH UPDATE scheduled to run "_$$FMTE^XLFDT(TIME)_"."
D TXT
D NOW^%DTC
S DAY=$E(%,1,7)
;
CHK2 ;
S TXT="" D TXT
;
S ICN=0,CNT=0
F S ICN=$O(^DPT("AICNL",1,ICN)) Q:'ICN S CNT=CNT+1
S TXT="Checking MPIF LOC/MIS ICN RES background job... (Total Local ICNs = "_CNT_")"
D TXT
;
S DIC="^DIC(19,",X="MPIF LOC/MIS ICN RES" D ^DIC K DIC S BKDA=+Y
I BKDA<0 S TXT="=> MPIF LOC/MIS ICN RES does not exist in OPTION file." D TXT K BKDA G CHK2A
S TXT="=> MPIF LOC/MIS ICN RES is not currently scheduled to run."
S DIC="^DIC(19.2,",X="MPIF LOC/MIS ICN RES" D ^DIC K DIC S SCHDA=+Y
I SCHDA<0 D TXT K BKDA,SCHDA G CHK2A
S TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
I TIME="" D TXT K BKDA,SCHDA,TIME G CHK2A
S TXT="=> MPIF LOC/MIS ICN RES is scheduled to run "_$$FMTE^XLFDT(TIME)_"."
D TXT
;
CHK2A ;check for time local/missing job was last run
S TIME=$P($G(^RGSITE(991.8,1,0)),"^",4) I TIME'="" D
.S TIME=$$FMTE^XLFDT(TIME)
.S TXT="=> MPIF LOC/MIS ICN RES was last run "_TIME_"."
.D TXT
;
;**78 VAMPI-28229 (jfw) - Monitor DG FIELD MONITOR PROTOCOL
CHK2AA ;check for VAFC MPIPD FIELD TRIGGER on DG FIELD MONITOR
N RGRSLT,RGX,RGB D FIND^XPDPROT(.RGRSLT,"VAFC MPIPD FIELD TRIGGER") ;IA #5567
S (RGB,RGX)=0 F S RGX=$O(RGRSLT(RGX)) Q:(RGX="") D
.S:(RGRSLT(RGX)="DG FIELD MONITOR") RGB=1
I ('RGB) D
.S TXT="" D TXT
.S TXT="=> VAFC MPIPD FIELD TRIGGER missing on DG FIELD MONITOR PROTOCOL." D TXT
;
CHK2B ;**75 - STORY 1203257 (dri) New Person Field Monitor Batch Update for daily stat report
S TXT="" D TXT
S TXT="Checking XUS IAM NPFM BATCH UPDATE background job..." D TXT
;
N RGCNT,RGIEN,RGUSER
S RGCNT=0,RGUSER=0 F S RGUSER=$O(^XTV(8933.1,"ACXMIT",RGUSER)) Q:'RGUSER D
.S RGIEN=0 F S RGIEN=$O(^XTV(8933.1,"ACXMIT",RGUSER,RGIEN)) Q:'RGIEN S RGCNT=RGCNT+1
S TXT="(Total NEW PERSON UPDATES waiting to be processed = "_RGCNT_")"
D TXT
;
S DIC="^DIC(19,",X="XUS IAM NPFM BATCH UPDATE" D ^DIC K DIC S BKDA=+Y
I BKDA<0 S TXT="=> XUS IAM NPFM BATCH UPDATE does not exist in OPTION file." D TXT K BKDA G CHK2C
S TXT="=> XUS IAM NPFM BATCH UPDATE is not currently scheduled to run."
S DIC="^DIC(19.2,",X="XUS IAM NPFM BATCH UPDATE" D ^DIC K DIC S SCHDA=+Y
I SCHDA<0 D TXT K BKDA,TXT,SCHDA G CHK2C
S TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
I TIME="" D TXT K BKDA,TXT,SCHDA,TIME G CHK2C
S TXT="=> XUS IAM NPFM BATCH UPDATE scheduled to run "_$$FMTE^XLFDT(TIME)_"."
D TXT
;
CHK2C ;**75 - STORY 1203257 (dri) New Person Field Monitor Purge for daily stat report
S TXT="" D TXT
S TXT="Checking XUS IAM NPFM PURGE background job..." D TXT
;
N RGDAT,RGCNT,RGDOMIEN,RGMIEN,RGPRGDAY,RGRETDAT,RGUSER,X1,X2
S RGDOMIEN=$O(^XTV(8989.3,0)) I 'RGDOMIEN G CHK3 ;domain
S RGPRGDAY=$$GET1^DIQ(8989.3,RGDOMIEN_",",875,"I") ;new person field monitor purge - days of transmitted data to retain.
I 'RGPRGDAY S RGPRGDAY=365 ;default if not defined
S X1=DT,X2=-RGPRGDAY D C^%DTC S RGRETDAT=X ;retain date
;
S RGCNT=0,RGDAT=0 F S RGDAT=$O(^XTV(8933.1,"B",RGDAT)) Q:'RGDAT!(RGDAT>RGRETDAT) D
.S RGMIEN=0 F S RGMIEN=$O(^XTV(8933.1,"B",RGDAT,RGMIEN)) Q:'RGMIEN S RGUSER=+$P($G(^XTV(8933.1,RGMIEN,0)),"^",2) I '$D(^XTV(8933.1,"ACXMIT",RGUSER,RGMIEN)) S RGCNT=RGCNT+1 ;count if not pending transmission
S TXT="(Total NEW PERSON UPDATES waiting to be purged = "_RGCNT_")"
D TXT
;
S DIC="^DIC(19,",X="XUS IAM NPFM PURGE" D ^DIC K DIC S BKDA=+Y
I BKDA<0 S TXT="=> XUS IAM NPFM PURGE does not exist in OPTION file." D TXT K BKDA G CHK3
S TXT="=> XUS IAM NPFM PURGE is not currently scheduled to run."
S DIC="^DIC(19.2,",X="XUS IAM NPFM PURGE" D ^DIC K DIC S SCHDA=+Y
I SCHDA<0 D TXT K BKDA,TXT,SCHDA G CHK3
S TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
I TIME="" D TXT K BKDA,TXT,SCHDA,TIME G CHK3
S TXT="=> XUS IAM NPFM PURGE scheduled to run "_$$FMTE^XLFDT(TIME)_"."
D TXT
;
CHK3 ;Check to see if .01 field in patient file has auditing turned on
S TXT="" D TXT
D FIELD^DID(2,.01,"","AUDIT","PATAUD")
S PATAUD=$G(PATAUD("AUDIT")) I PATAUD="" S PATAUD="NOT SET"
S PATAUD="<<"_PATAUD_">>"
S TXT="=> Audit on NAME (#.01) field of PATIENT (#2) file set to "_PATAUD
D TXT
K PATAUD
;
CHK5 ;
S TXT="" D TXT
;
S TXT="Checking SEND Parameters for HL7 messaging..."
D TXT
;
S SEND=$P($$SEND^VAFHUTL,"^",2)
S CUR=$S(SEND=1:"SEND MESSAGES",SEND=0:"STOP MESSAGES",SEND=2:"SUSPEND MESSAGES",1:"NULL")
S TXT="=> SEND PIMS HL7 V2.3 MESSAGES currently set to << "_CUR_" >>."
D TXT
;
S TXT="=> STOP MPI/PD MESSAGING currently set to "
S SEND=$P($G(^RGSITE(991.8,1,1)),"^",6)
S CUR=$S(SEND=1:"SEND MESSAGES",SEND=0:"STOP MESSAGES",SEND=2:"SUSPEND MESSAGES",1:"NULL")
S TXT="=> STOP MPI/PD MESSAGING currently set to << "_CUR_" >>."
D TXT
;
CHK6 ;
K RGMT
S LOC=$P($$SITE^VASITE(),"^")
D LINK^HLUTIL3(LOC,.RGMT)
S LOCIEN=$O(RGMT(0))
I 'LOCIEN D G QUIT
.S TXT="^DIC(4,""AC"" xref problem. Check ^DIC(4,""AC"",,"_LOC
.D TXT
S LOCLINK=RGMT(LOCIEN)
;
S TXT="" D TXT
;
S TXT="Checking SHUTDOWN LLP? field and TCP/IP SERVICE TYPE for "_LOCLINK_"..."
D TXT
;
S CUR=$$GET1^DIQ(870,LOCIEN_",",14)
S TXT="=> SHUTDOWN LLP? currently set to << "_CUR_" >>."
D TXT
;
S CUR=$$GET1^DIQ(870,LOCIEN_",",400.03)
S TXT="=> TCP/IP SERVICE TYPE currently set to << "_CUR_" >>."
D TXT
;
;check MPIVA for LLP TYPE
S DIC="^HLCS(870,",X="MPIVA" D ^DIC K DIC S MPILL=+Y
S CUR=$$GET1^DIQ(870,MPILL_",",2)
S TXT="=> Logical Link MPIVA currently set to << "_CUR_" >>."
D TXT
;
;check to see if Link Manager is running
S LMSTAT=$$STAT^HLCSLM
S CUR=$S('LMSTAT:"NOT RUNNING",1:"RUNNING")
S TXT="=> HL LINK MANAGER is currently << "_CUR_" >>."
D TXT
;check to see if RG QUEUE is okay
S TXT="Checking Resource Device - RG QUEUE" D TXT
N RGEN S RGEN=$O(^%ZISL(3.54,"B","RG QUEUE",""))
I RGEN="" S TXT="=> No RG QUEUE resource device"
I RGEN>0 S TXT="=> RG QUEUE, SLOTS AVAILABLE: "_$P(^%ZISL(3.54,RGEN,0),"^",2)
D TXT
;
FLDLIST ;capture fields being audited
I $D(RGHLMQ) D
.S AUDCNT=0
.S ^XTMP("RGMT","HLMQMONT",LOCSITE,"AUDIT",0)="Compiled: "_$$FMTE^XLFDT($$NOW^XLFDT)
.S FLDLP=0 F S FLDLP=$O(^DD(2,"AUDIT",FLDLP)) Q:'FLDLP D
..S AUDCNT=AUDCNT+1
..K RGARR D FIELD^DID(2,FLDLP,"","LABEL","RGARR")
..S FLDNM=$G(RGARR("LABEL")) Q:FLDNM=""
..S ^XTMP("RGMT","HLMQMONT",LOCSITE,"AUDIT",AUDCNT)=FLDLP_"^"_FLDNM
;
I $D(CLUP),$D(DIRUT) Q
;
QUIT ;
K %,BKDA,CLUP,CNT,CUR,DAY,DIR,DIRUT,ICN,JJ,LMSTAT,LOC,LOCIEN,LOCLINK
K LOCSITE,MPILL,MSG,PATAUD,RGHLMQ,RGMT,SCHDA,SEND,SS,TIME,TXT,TXTCNT,X,Y
K AUDCNT,FLDLP,RGARR,FLDNM
Q
;
TXT ;
S TXTCNT=TXTCNT+1
I '$D(RGHLMQ) W !,TXT
I $D(RGHLMQ) S ^XTMP("RGMT","HLMQMONT",LOCSITE,TXTCNT)=TXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTMONT 9282 printed Sep 23, 2025@19:18:24 Page 2
RGMTMONT ;BIR/CML,PTD-MPI/PD Monitor HL7 Messaging/Filers and Setups ;6/25/20 15:14
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**20,30,31,34,75,78**;30 Apr 99;Build 1
+2 ;
+3 ;Reference to PROTOCOL (#101) file supported by IA #5567
+4 ;Reference to OPTION (#19) file supported by IA #10075
+5 ;Reference to OPTION SCHEDULING (#19.2) file supported by IA #3599
+6 ;Reference to ^DPT("AICNL" supported by IA #2070
+7 ;Reference to $$SEND^VAFHUTL for file DG(43 supported by IA #2624
+8 ;Reference to ^HLCS(870 supported by IA #3335
+9 ;Reference to $$STAT^HLCSLM supported by IA #3574
+10 ;Reference to ^DIA(2 and data derived from the AUDIT file (#1.1)
+11 ; supported by IA #2097 and #2602.
+12 ;Reference to ^XTV(8933.1 supported by IA #7177
+13 ;Reference to ^XTV(8989.3 supported by IA #7183
+14 ;
EN1 ;Call this routine from the top to do extended checks that include:
+1 ;- D HLMA1^RGMTUT98
+2 ;- D EN2^RGMTMONT
+3 ;- D ^RGMTMONX
+4 ;
+5 IF $DATA(RGHLMQ)
QUIT
+6 ;
+7 SET DEV=0
SET EN=1
GOTO START
+8 ;
DEV ;call used by developers to display ^RGMTMONX call
+1 SET DEV=1
SET EN=2
+2 ;
START ;
+1 SET CLUP=1
+2 WRITE @IOF,"Logical Link Monitor:",!,"=====================",!
+3 DO HLMA1^RGMTUT98
+4 SET DIR(0)="E"
Begin DoDot:1
+5 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
End DoDot:1
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO QUIT
+7 ;
+8 DO EN2
+9 SET DIR(0)="E"
Begin DoDot:1
+10 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
End DoDot:1
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
GOTO QUIT
+12 ;
+13 IF $GET(EN)'=1
DO ^RGMTMONX
+14 ;
+15 KILL EN,DEV
GOTO QUIT
+16 ;
EN2 ;Monitor Background Job - VAFC BATCH UPDATE
+1 ;Monitor Background Job - MPIF LOC/MIS ICN RES
+2 ;Check MAS PARAMETER file, field SEND PIMS HL7 V2.3 MESSAGES
+3 ;if call is being made from HL7 query, variable RGHLMQ will be defined
+4 SET ^XTMP("RGMT",0)=$$FMADD^XLFDT(DT,30)_"^"_$$NOW^XLFDT_"^MPI/PD Maintenance Data"
+5 KILL ^XTMP("RGMT","HLMQMONT")
+6 IF '$DATA(DEV)
SET DEV=0
+7 SET LOCSITE=$PIECE($$SITE^VASITE(),"^",3)
+8 IF $DATA(RGHLMQ)
Begin DoDot:1
+9 DO NOW^%DTC
+10 SET ^XTMP("RGMT","HLMQMONT",LOCSITE,"@@ RUNDATE")=$$FMTE^XLFDT($EXTRACT(%,1,12))
End DoDot:1
+11 IF '$DATA(RGHLMQ)
WRITE @IOF,"MPI/PD Process Monitor:",!,"======================="
+12 SET TXTCNT=0
+13 NEW BKDA,CUR,MSG,SCHDA,SEND,TIME
CHK1 ;
+1 SET TXT="Checking VAFC BATCH UPDATE background job..."
DO TXT
+2 DO PIV^RGMTUT98
+3 SET TXTCNT=3
+4 ;
+5 SET DIC="^DIC(19,"
SET X="VAFC BATCH UPDATE"
DO ^DIC
KILL DIC
SET BKDA=+Y
+6 IF BKDA<0
SET TXT="=> VAFC BATCH UPDATE does not exist in OPTION file."
DO TXT
KILL BKDA
GOTO CHK2
+7 SET TXT="=> VAFC BATCH UPDATE is not currently scheduled to run."
+8 SET DIC="^DIC(19.2,"
SET X="VAFC BATCH UPDATE"
DO ^DIC
KILL DIC
SET SCHDA=+Y
+9 IF SCHDA<0
DO TXT
KILL BKDA,TXT,SCHDA
GOTO CHK2
+10 SET TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
+11 IF TIME=""
DO TXT
KILL BKDA,TXT,SCHDA,TIME
GOTO CHK2
+12 SET TXT="=> VAFC BATCH UPDATE scheduled to run "_$$FMTE^XLFDT(TIME)_"."
+13 DO TXT
+14 DO NOW^%DTC
+15 SET DAY=$EXTRACT(%,1,7)
+16 ;
CHK2 ;
+1 SET TXT=""
DO TXT
+2 ;
+3 SET ICN=0
SET CNT=0
+4 FOR
SET ICN=$ORDER(^DPT("AICNL",1,ICN))
if 'ICN
QUIT
SET CNT=CNT+1
+5 SET TXT="Checking MPIF LOC/MIS ICN RES background job... (Total Local ICNs = "_CNT_")"
+6 DO TXT
+7 ;
+8 SET DIC="^DIC(19,"
SET X="MPIF LOC/MIS ICN RES"
DO ^DIC
KILL DIC
SET BKDA=+Y
+9 IF BKDA<0
SET TXT="=> MPIF LOC/MIS ICN RES does not exist in OPTION file."
DO TXT
KILL BKDA
GOTO CHK2A
+10 SET TXT="=> MPIF LOC/MIS ICN RES is not currently scheduled to run."
+11 SET DIC="^DIC(19.2,"
SET X="MPIF LOC/MIS ICN RES"
DO ^DIC
KILL DIC
SET SCHDA=+Y
+12 IF SCHDA<0
DO TXT
KILL BKDA,SCHDA
GOTO CHK2A
+13 SET TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
+14 IF TIME=""
DO TXT
KILL BKDA,SCHDA,TIME
GOTO CHK2A
+15 SET TXT="=> MPIF LOC/MIS ICN RES is scheduled to run "_$$FMTE^XLFDT(TIME)_"."
+16 DO TXT
+17 ;
CHK2A ;check for time local/missing job was last run
+1 SET TIME=$PIECE($GET(^RGSITE(991.8,1,0)),"^",4)
IF TIME'=""
Begin DoDot:1
+2 SET TIME=$$FMTE^XLFDT(TIME)
+3 SET TXT="=> MPIF LOC/MIS ICN RES was last run "_TIME_"."
+4 DO TXT
End DoDot:1
+5 ;
+6 ;**78 VAMPI-28229 (jfw) - Monitor DG FIELD MONITOR PROTOCOL
CHK2AA ;check for VAFC MPIPD FIELD TRIGGER on DG FIELD MONITOR
+1 ;IA #5567
NEW RGRSLT,RGX,RGB
DO FIND^XPDPROT(.RGRSLT,"VAFC MPIPD FIELD TRIGGER")
+2 SET (RGB,RGX)=0
FOR
SET RGX=$ORDER(RGRSLT(RGX))
if (RGX="")
QUIT
Begin DoDot:1
+3 if (RGRSLT(RGX)="DG FIELD MONITOR")
SET RGB=1
End DoDot:1
+4 IF ('RGB)
Begin DoDot:1
+5 SET TXT=""
DO TXT
+6 SET TXT="=> VAFC MPIPD FIELD TRIGGER missing on DG FIELD MONITOR PROTOCOL."
DO TXT
End DoDot:1
+7 ;
CHK2B ;**75 - STORY 1203257 (dri) New Person Field Monitor Batch Update for daily stat report
+1 SET TXT=""
DO TXT
+2 SET TXT="Checking XUS IAM NPFM BATCH UPDATE background job..."
DO TXT
+3 ;
+4 NEW RGCNT,RGIEN,RGUSER
+5 SET RGCNT=0
SET RGUSER=0
FOR
SET RGUSER=$ORDER(^XTV(8933.1,"ACXMIT",RGUSER))
if 'RGUSER
QUIT
Begin DoDot:1
+6 SET RGIEN=0
FOR
SET RGIEN=$ORDER(^XTV(8933.1,"ACXMIT",RGUSER,RGIEN))
if 'RGIEN
QUIT
SET RGCNT=RGCNT+1
End DoDot:1
+7 SET TXT="(Total NEW PERSON UPDATES waiting to be processed = "_RGCNT_")"
+8 DO TXT
+9 ;
+10 SET DIC="^DIC(19,"
SET X="XUS IAM NPFM BATCH UPDATE"
DO ^DIC
KILL DIC
SET BKDA=+Y
+11 IF BKDA<0
SET TXT="=> XUS IAM NPFM BATCH UPDATE does not exist in OPTION file."
DO TXT
KILL BKDA
GOTO CHK2C
+12 SET TXT="=> XUS IAM NPFM BATCH UPDATE is not currently scheduled to run."
+13 SET DIC="^DIC(19.2,"
SET X="XUS IAM NPFM BATCH UPDATE"
DO ^DIC
KILL DIC
SET SCHDA=+Y
+14 IF SCHDA<0
DO TXT
KILL BKDA,TXT,SCHDA
GOTO CHK2C
+15 SET TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
+16 IF TIME=""
DO TXT
KILL BKDA,TXT,SCHDA,TIME
GOTO CHK2C
+17 SET TXT="=> XUS IAM NPFM BATCH UPDATE scheduled to run "_$$FMTE^XLFDT(TIME)_"."
+18 DO TXT
+19 ;
CHK2C ;**75 - STORY 1203257 (dri) New Person Field Monitor Purge for daily stat report
+1 SET TXT=""
DO TXT
+2 SET TXT="Checking XUS IAM NPFM PURGE background job..."
DO TXT
+3 ;
+4 NEW RGDAT,RGCNT,RGDOMIEN,RGMIEN,RGPRGDAY,RGRETDAT,RGUSER,X1,X2
+5 ;domain
SET RGDOMIEN=$ORDER(^XTV(8989.3,0))
IF 'RGDOMIEN
GOTO CHK3
+6 ;new person field monitor purge - days of transmitted data to retain.
SET RGPRGDAY=$$GET1^DIQ(8989.3,RGDOMIEN_",",875,"I")
+7 ;default if not defined
IF 'RGPRGDAY
SET RGPRGDAY=365
+8 ;retain date
SET X1=DT
SET X2=-RGPRGDAY
DO C^%DTC
SET RGRETDAT=X
+9 ;
+10 SET RGCNT=0
SET RGDAT=0
FOR
SET RGDAT=$ORDER(^XTV(8933.1,"B",RGDAT))
if 'RGDAT!(RGDAT>RGRETDAT)
QUIT
Begin DoDot:1
+11 ;count if not pending transmission
SET RGMIEN=0
FOR
SET RGMIEN=$ORDER(^XTV(8933.1,"B",RGDAT,RGMIEN))
if 'RGMIEN
QUIT
SET RGUSER=+$PIECE($GET(^XTV(8933.1,RGMIEN,0)),"^",2)
IF '$DATA(^XTV(8933.1,"ACXMIT",RGUSER,RGMIEN))
SET RGCNT=RGCNT+1
End DoDot:1
+12 SET TXT="(Total NEW PERSON UPDATES waiting to be purged = "_RGCNT_")"
+13 DO TXT
+14 ;
+15 SET DIC="^DIC(19,"
SET X="XUS IAM NPFM PURGE"
DO ^DIC
KILL DIC
SET BKDA=+Y
+16 IF BKDA<0
SET TXT="=> XUS IAM NPFM PURGE does not exist in OPTION file."
DO TXT
KILL BKDA
GOTO CHK3
+17 SET TXT="=> XUS IAM NPFM PURGE is not currently scheduled to run."
+18 SET DIC="^DIC(19.2,"
SET X="XUS IAM NPFM PURGE"
DO ^DIC
KILL DIC
SET SCHDA=+Y
+19 IF SCHDA<0
DO TXT
KILL BKDA,TXT,SCHDA
GOTO CHK3
+20 SET TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
+21 IF TIME=""
DO TXT
KILL BKDA,TXT,SCHDA,TIME
GOTO CHK3
+22 SET TXT="=> XUS IAM NPFM PURGE scheduled to run "_$$FMTE^XLFDT(TIME)_"."
+23 DO TXT
+24 ;
CHK3 ;Check to see if .01 field in patient file has auditing turned on
+1 SET TXT=""
DO TXT
+2 DO FIELD^DID(2,.01,"","AUDIT","PATAUD")
+3 SET PATAUD=$GET(PATAUD("AUDIT"))
IF PATAUD=""
SET PATAUD="NOT SET"
+4 SET PATAUD="<<"_PATAUD_">>"
+5 SET TXT="=> Audit on NAME (#.01) field of PATIENT (#2) file set to "_PATAUD
+6 DO TXT
+7 KILL PATAUD
+8 ;
CHK5 ;
+1 SET TXT=""
DO TXT
+2 ;
+3 SET TXT="Checking SEND Parameters for HL7 messaging..."
+4 DO TXT
+5 ;
+6 SET SEND=$PIECE($$SEND^VAFHUTL,"^",2)
+7 SET CUR=$SELECT(SEND=1:"SEND MESSAGES",SEND=0:"STOP MESSAGES",SEND=2:"SUSPEND MESSAGES",1:"NULL")
+8 SET TXT="=> SEND PIMS HL7 V2.3 MESSAGES currently set to << "_CUR_" >>."
+9 DO TXT
+10 ;
+11 SET TXT="=> STOP MPI/PD MESSAGING currently set to "
+12 SET SEND=$PIECE($GET(^RGSITE(991.8,1,1)),"^",6)
+13 SET CUR=$SELECT(SEND=1:"SEND MESSAGES",SEND=0:"STOP MESSAGES",SEND=2:"SUSPEND MESSAGES",1:"NULL")
+14 SET TXT="=> STOP MPI/PD MESSAGING currently set to << "_CUR_" >>."
+15 DO TXT
+16 ;
CHK6 ;
+1 KILL RGMT
+2 SET LOC=$PIECE($$SITE^VASITE(),"^")
+3 DO LINK^HLUTIL3(LOC,.RGMT)
+4 SET LOCIEN=$ORDER(RGMT(0))
+5 IF 'LOCIEN
Begin DoDot:1
+6 SET TXT="^DIC(4,""AC"" xref problem. Check ^DIC(4,""AC"",,"_LOC
+7 DO TXT
End DoDot:1
GOTO QUIT
+8 SET LOCLINK=RGMT(LOCIEN)
+9 ;
+10 SET TXT=""
DO TXT
+11 ;
+12 SET TXT="Checking SHUTDOWN LLP? field and TCP/IP SERVICE TYPE for "_LOCLINK_"..."
+13 DO TXT
+14 ;
+15 SET CUR=$$GET1^DIQ(870,LOCIEN_",",14)
+16 SET TXT="=> SHUTDOWN LLP? currently set to << "_CUR_" >>."
+17 DO TXT
+18 ;
+19 SET CUR=$$GET1^DIQ(870,LOCIEN_",",400.03)
+20 SET TXT="=> TCP/IP SERVICE TYPE currently set to << "_CUR_" >>."
+21 DO TXT
+22 ;
+23 ;check MPIVA for LLP TYPE
+24 SET DIC="^HLCS(870,"
SET X="MPIVA"
DO ^DIC
KILL DIC
SET MPILL=+Y
+25 SET CUR=$$GET1^DIQ(870,MPILL_",",2)
+26 SET TXT="=> Logical Link MPIVA currently set to << "_CUR_" >>."
+27 DO TXT
+28 ;
+29 ;check to see if Link Manager is running
+30 SET LMSTAT=$$STAT^HLCSLM
+31 SET CUR=$SELECT('LMSTAT:"NOT RUNNING",1:"RUNNING")
+32 SET TXT="=> HL LINK MANAGER is currently << "_CUR_" >>."
+33 DO TXT
+34 ;check to see if RG QUEUE is okay
+35 SET TXT="Checking Resource Device - RG QUEUE"
DO TXT
+36 NEW RGEN
SET RGEN=$ORDER(^%ZISL(3.54,"B","RG QUEUE",""))
+37 IF RGEN=""
SET TXT="=> No RG QUEUE resource device"
+38 IF RGEN>0
SET TXT="=> RG QUEUE, SLOTS AVAILABLE: "_$PIECE(^%ZISL(3.54,RGEN,0),"^",2)
+39 DO TXT
+40 ;
FLDLIST ;capture fields being audited
+1 IF $DATA(RGHLMQ)
Begin DoDot:1
+2 SET AUDCNT=0
+3 SET ^XTMP("RGMT","HLMQMONT",LOCSITE,"AUDIT",0)="Compiled: "_$$FMTE^XLFDT($$NOW^XLFDT)
+4 SET FLDLP=0
FOR
SET FLDLP=$ORDER(^DD(2,"AUDIT",FLDLP))
if 'FLDLP
QUIT
Begin DoDot:2
+5 SET AUDCNT=AUDCNT+1
+6 KILL RGARR
DO FIELD^DID(2,FLDLP,"","LABEL","RGARR")
+7 SET FLDNM=$GET(RGARR("LABEL"))
if FLDNM=""
QUIT
+8 SET ^XTMP("RGMT","HLMQMONT",LOCSITE,"AUDIT",AUDCNT)=FLDLP_"^"_FLDNM
End DoDot:2
End DoDot:1
+9 ;
+10 IF $DATA(CLUP)
IF $DATA(DIRUT)
QUIT
+11 ;
QUIT ;
+1 KILL %,BKDA,CLUP,CNT,CUR,DAY,DIR,DIRUT,ICN,JJ,LMSTAT,LOC,LOCIEN,LOCLINK
+2 KILL LOCSITE,MPILL,MSG,PATAUD,RGHLMQ,RGMT,SCHDA,SEND,SS,TIME,TXT,TXTCNT,X,Y
+3 KILL AUDCNT,FLDLP,RGARR,FLDNM
+4 QUIT
+5 ;
TXT ;
+1 SET TXTCNT=TXTCNT+1
+2 IF '$DATA(RGHLMQ)
WRITE !,TXT
+3 IF $DATA(RGHLMQ)
SET ^XTMP("RGMT","HLMQMONT",LOCSITE,TXTCNT)=TXT
+4 QUIT
