Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RGMTMONT

RGMTMONT.m

Go to the documentation of this file.
  1. 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**;30 Apr 99;Build 1
  1. ;
  1. ;Reference to OPTION (#19) file supported by IA #10075
  1. ;Reference to OPTION SCHEDULING (#19.2) file supported by IA #3599
  1. ;Reference to ^DPT("AICNL" supported by IA #2070
  1. ;Reference to $$SEND^VAFHUTL for file DG(43 supported by IA #2624
  1. ;Reference to ^HLCS(870 supported by IA #3335
  1. ;Reference to $$STAT^HLCSLM supported by IA #3574
  1. ;Reference to ^DIA(2 and data derived from the AUDIT file (#1.1)
  1. ; supported by IA #2097 and #2602.
  1. ;Reference to ^XTV(8933.1 supported by IA #7177
  1. ;Reference to ^XTV(8989.3 supported by IA #7183
  1. ;
  1. EN1 ;Call this routine from the top to do extended checks that include:
  1. ;- D HLMA1^RGMTUT98
  1. ;- D EN2^RGMTMONT
  1. ;- D ^RGMTMONX
  1. ;
  1. I $D(RGHLMQ) Q
  1. ;
  1. S DEV=0,EN=1 G START
  1. ;
  1. DEV ;call used by developers to display ^RGMTMONX call
  1. S DEV=1,EN=2
  1. ;
  1. START ;
  1. S CLUP=1
  1. W @IOF,"Logical Link Monitor:",!,"=====================",!
  1. D HLMA1^RGMTUT98
  1. S DIR(0)="E" D D ^DIR K DIR
  1. .S SS=22-$Y F JJ=1:1:SS W !
  1. I $D(DIRUT) G QUIT
  1. ;
  1. D EN2
  1. S DIR(0)="E" D D ^DIR K DIR
  1. .S SS=22-$Y F JJ=1:1:SS W !
  1. I $D(DIRUT) G QUIT
  1. ;
  1. I $G(EN)'=1 D ^RGMTMONX
  1. ;
  1. K EN,DEV G QUIT
  1. ;
  1. EN2 ;Monitor Background Job - VAFC BATCH UPDATE
  1. ;Monitor Background Job - MPIF LOC/MIS ICN RES
  1. ;Check MAS PARAMETER file, field SEND PIMS HL7 V2.3 MESSAGES
  1. ;if call is being made from HL7 query, variable RGHLMQ will be defined
  1. S ^XTMP("RGMT",0)=$$FMADD^XLFDT(DT,30)_"^"_$$NOW^XLFDT_"^MPI/PD Maintenance Data"
  1. K ^XTMP("RGMT","HLMQMONT")
  1. I '$D(DEV) S DEV=0
  1. S LOCSITE=$P($$SITE^VASITE(),"^",3)
  1. I $D(RGHLMQ) D
  1. .D NOW^%DTC
  1. .S ^XTMP("RGMT","HLMQMONT",LOCSITE,"@@ RUNDATE")=$$FMTE^XLFDT($E(%,1,12))
  1. I '$D(RGHLMQ) W @IOF,"MPI/PD Process Monitor:",!,"======================="
  1. S TXTCNT=0
  1. N BKDA,CUR,MSG,SCHDA,SEND,TIME
  1. CHK1 ;
  1. S TXT="Checking VAFC BATCH UPDATE background job..." D TXT
  1. D PIV^RGMTUT98
  1. S TXTCNT=3
  1. ;
  1. S DIC="^DIC(19,",X="VAFC BATCH UPDATE" D ^DIC K DIC S BKDA=+Y
  1. I BKDA<0 S TXT="=> VAFC BATCH UPDATE does not exist in OPTION file." D TXT K BKDA G CHK2
  1. S TXT="=> VAFC BATCH UPDATE is not currently scheduled to run."
  1. S DIC="^DIC(19.2,",X="VAFC BATCH UPDATE" D ^DIC K DIC S SCHDA=+Y
  1. I SCHDA<0 D TXT K BKDA,TXT,SCHDA G CHK2
  1. S TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
  1. I TIME="" D TXT K BKDA,TXT,SCHDA,TIME G CHK2
  1. S TXT="=> VAFC BATCH UPDATE scheduled to run "_$$FMTE^XLFDT(TIME)_"."
  1. D TXT
  1. D NOW^%DTC
  1. S DAY=$E(%,1,7)
  1. ;
  1. CHK2 ;
  1. S TXT="" D TXT
  1. ;
  1. S ICN=0,CNT=0
  1. F S ICN=$O(^DPT("AICNL",1,ICN)) Q:'ICN S CNT=CNT+1
  1. S TXT="Checking MPIF LOC/MIS ICN RES background job... (Total Local ICNs = "_CNT_")"
  1. D TXT
  1. ;
  1. S DIC="^DIC(19,",X="MPIF LOC/MIS ICN RES" D ^DIC K DIC S BKDA=+Y
  1. I BKDA<0 S TXT="=> MPIF LOC/MIS ICN RES does not exist in OPTION file." D TXT K BKDA G CHK2A
  1. S TXT="=> MPIF LOC/MIS ICN RES is not currently scheduled to run."
  1. S DIC="^DIC(19.2,",X="MPIF LOC/MIS ICN RES" D ^DIC K DIC S SCHDA=+Y
  1. I SCHDA<0 D TXT K BKDA,SCHDA G CHK2A
  1. S TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
  1. I TIME="" D TXT K BKDA,SCHDA,TIME G CHK2A
  1. S TXT="=> MPIF LOC/MIS ICN RES is scheduled to run "_$$FMTE^XLFDT(TIME)_"."
  1. D TXT
  1. ;
  1. CHK2A ;check for time local/missing job was last run
  1. S TIME=$P($G(^RGSITE(991.8,1,0)),"^",4) I TIME'="" D
  1. .S TIME=$$FMTE^XLFDT(TIME)
  1. .S TXT="=> MPIF LOC/MIS ICN RES was last run "_TIME_"."
  1. .D TXT
  1. ;
  1. CHK2B ;**75 - STORY 1203257 (dri) New Person Field Monitor Batch Update for daily stat report
  1. S TXT="" D TXT
  1. S TXT="Checking XUS IAM NPFM BATCH UPDATE background job..." D TXT
  1. ;
  1. N RGCNT,RGIEN,RGUSER
  1. S RGCNT=0,RGUSER=0 F S RGUSER=$O(^XTV(8933.1,"ACXMIT",RGUSER)) Q:'RGUSER D
  1. .S RGIEN=0 F S RGIEN=$O(^XTV(8933.1,"ACXMIT",RGUSER,RGIEN)) Q:'RGIEN S RGCNT=RGCNT+1
  1. S TXT="(Total NEW PERSON UPDATES waiting to be processed = "_RGCNT_")"
  1. D TXT
  1. ;
  1. S DIC="^DIC(19,",X="XUS IAM NPFM BATCH UPDATE" D ^DIC K DIC S BKDA=+Y
  1. I BKDA<0 S TXT="=> XUS IAM NPFM BATCH UPDATE does not exist in OPTION file." D TXT K BKDA G CHK2C
  1. S TXT="=> XUS IAM NPFM BATCH UPDATE is not currently scheduled to run."
  1. S DIC="^DIC(19.2,",X="XUS IAM NPFM BATCH UPDATE" D ^DIC K DIC S SCHDA=+Y
  1. I SCHDA<0 D TXT K BKDA,TXT,SCHDA G CHK2C
  1. S TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
  1. I TIME="" D TXT K BKDA,TXT,SCHDA,TIME G CHK2C
  1. S TXT="=> XUS IAM NPFM BATCH UPDATE scheduled to run "_$$FMTE^XLFDT(TIME)_"."
  1. D TXT
  1. ;
  1. CHK2C ;**75 - STORY 1203257 (dri) New Person Field Monitor Purge for daily stat report
  1. S TXT="" D TXT
  1. S TXT="Checking XUS IAM NPFM PURGE background job..." D TXT
  1. ;
  1. N RGDAT,RGCNT,RGDOMIEN,RGMIEN,RGPRGDAY,RGRETDAT,RGUSER,X1,X2
  1. S RGDOMIEN=$O(^XTV(8989.3,0)) I 'RGDOMIEN G CHK3 ;domain
  1. S RGPRGDAY=$$GET1^DIQ(8989.3,RGDOMIEN_",",875,"I") ;new person field monitor purge - days of transmitted data to retain.
  1. I 'RGPRGDAY S RGPRGDAY=365 ;default if not defined
  1. S X1=DT,X2=-RGPRGDAY D C^%DTC S RGRETDAT=X ;retain date
  1. ;
  1. S RGCNT=0,RGDAT=0 F S RGDAT=$O(^XTV(8933.1,"B",RGDAT)) Q:'RGDAT!(RGDAT>RGRETDAT) D
  1. .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
  1. S TXT="(Total NEW PERSON UPDATES waiting to be purged = "_RGCNT_")"
  1. D TXT
  1. ;
  1. S DIC="^DIC(19,",X="XUS IAM NPFM PURGE" D ^DIC K DIC S BKDA=+Y
  1. I BKDA<0 S TXT="=> XUS IAM NPFM PURGE does not exist in OPTION file." D TXT K BKDA G CHK3
  1. S TXT="=> XUS IAM NPFM PURGE is not currently scheduled to run."
  1. S DIC="^DIC(19.2,",X="XUS IAM NPFM PURGE" D ^DIC K DIC S SCHDA=+Y
  1. I SCHDA<0 D TXT K BKDA,TXT,SCHDA G CHK3
  1. S TIME=$$GET1^DIQ(19.2,SCHDA_",",2)
  1. I TIME="" D TXT K BKDA,TXT,SCHDA,TIME G CHK3
  1. S TXT="=> XUS IAM NPFM PURGE scheduled to run "_$$FMTE^XLFDT(TIME)_"."
  1. D TXT
  1. ;
  1. CHK3 ;Check to see if .01 field in patient file has auditing turned on
  1. S TXT="" D TXT
  1. D FIELD^DID(2,.01,"","AUDIT","PATAUD")
  1. S PATAUD=$G(PATAUD("AUDIT")) I PATAUD="" S PATAUD="NOT SET"
  1. S PATAUD="<<"_PATAUD_">>"
  1. S TXT="=> Audit on NAME (#.01) field of PATIENT (#2) file set to "_PATAUD
  1. D TXT
  1. K PATAUD
  1. ;
  1. CHK5 ;
  1. S TXT="" D TXT
  1. ;
  1. S TXT="Checking SEND Parameters for HL7 messaging..."
  1. D TXT
  1. ;
  1. S SEND=$P($$SEND^VAFHUTL,"^",2)
  1. S CUR=$S(SEND=1:"SEND MESSAGES",SEND=0:"STOP MESSAGES",SEND=2:"SUSPEND MESSAGES",1:"NULL")
  1. S TXT="=> SEND PIMS HL7 V2.3 MESSAGES currently set to << "_CUR_" >>."
  1. D TXT
  1. ;
  1. S TXT="=> STOP MPI/PD MESSAGING currently set to "
  1. S SEND=$P($G(^RGSITE(991.8,1,1)),"^",6)
  1. S CUR=$S(SEND=1:"SEND MESSAGES",SEND=0:"STOP MESSAGES",SEND=2:"SUSPEND MESSAGES",1:"NULL")
  1. S TXT="=> STOP MPI/PD MESSAGING currently set to << "_CUR_" >>."
  1. D TXT
  1. ;
  1. CHK6 ;
  1. K RGMT
  1. S LOC=$P($$SITE^VASITE(),"^")
  1. D LINK^HLUTIL3(LOC,.RGMT)
  1. S LOCIEN=$O(RGMT(0))
  1. I 'LOCIEN D G QUIT
  1. .S TXT="^DIC(4,""AC"" xref problem. Check ^DIC(4,""AC"",,"_LOC
  1. .D TXT
  1. S LOCLINK=RGMT(LOCIEN)
  1. ;
  1. S TXT="" D TXT
  1. ;
  1. S TXT="Checking SHUTDOWN LLP? field and TCP/IP SERVICE TYPE for "_LOCLINK_"..."
  1. D TXT
  1. ;
  1. S CUR=$$GET1^DIQ(870,LOCIEN_",",14)
  1. S TXT="=> SHUTDOWN LLP? currently set to << "_CUR_" >>."
  1. D TXT
  1. ;
  1. S CUR=$$GET1^DIQ(870,LOCIEN_",",400.03)
  1. S TXT="=> TCP/IP SERVICE TYPE currently set to << "_CUR_" >>."
  1. D TXT
  1. ;
  1. ;check MPIVA for LLP TYPE
  1. S DIC="^HLCS(870,",X="MPIVA" D ^DIC K DIC S MPILL=+Y
  1. S CUR=$$GET1^DIQ(870,MPILL_",",2)
  1. S TXT="=> Logical Link MPIVA currently set to << "_CUR_" >>."
  1. D TXT
  1. ;
  1. ;check to see if Link Manager is running
  1. S LMSTAT=$$STAT^HLCSLM
  1. S CUR=$S('LMSTAT:"NOT RUNNING",1:"RUNNING")
  1. S TXT="=> HL LINK MANAGER is currently << "_CUR_" >>."
  1. D TXT
  1. ;check to see if RG QUEUE is okay
  1. S TXT="Checking Resource Device - RG QUEUE" D TXT
  1. N RGEN S RGEN=$O(^%ZISL(3.54,"B","RG QUEUE",""))
  1. I RGEN="" S TXT="=> No RG QUEUE resource device"
  1. I RGEN>0 S TXT="=> RG QUEUE, SLOTS AVAILABLE: "_$P(^%ZISL(3.54,RGEN,0),"^",2)
  1. D TXT
  1. ;
  1. FLDLIST ;capture fields being audited
  1. I $D(RGHLMQ) D
  1. .S AUDCNT=0
  1. .S ^XTMP("RGMT","HLMQMONT",LOCSITE,"AUDIT",0)="Compiled: "_$$FMTE^XLFDT($$NOW^XLFDT)
  1. .S FLDLP=0 F S FLDLP=$O(^DD(2,"AUDIT",FLDLP)) Q:'FLDLP D
  1. ..S AUDCNT=AUDCNT+1
  1. ..K RGARR D FIELD^DID(2,FLDLP,"","LABEL","RGARR")
  1. ..S FLDNM=$G(RGARR("LABEL")) Q:FLDNM=""
  1. ..S ^XTMP("RGMT","HLMQMONT",LOCSITE,"AUDIT",AUDCNT)=FLDLP_"^"_FLDNM
  1. ;
  1. I $D(CLUP),$D(DIRUT) Q
  1. ;
  1. QUIT ;
  1. K %,BKDA,CLUP,CNT,CUR,DAY,DIR,DIRUT,ICN,JJ,LMSTAT,LOC,LOCIEN,LOCLINK
  1. K LOCSITE,MPILL,MSG,PATAUD,RGHLMQ,RGMT,SCHDA,SEND,SS,TIME,TXT,TXTCNT,X,Y
  1. K AUDCNT,FLDLP,RGARR,FLDNM
  1. Q
  1. ;
  1. TXT ;
  1. S TXTCNT=TXTCNT+1
  1. I '$D(RGHLMQ) W !,TXT
  1. I $D(RGHLMQ) S ^XTMP("RGMT","HLMQMONT",LOCSITE,TXTCNT)=TXT
  1. Q