- 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**;30 Apr 99;Build 1
- ;
- ;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
- ;
- 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 8795 printed Jan 18, 2025@02:43:39 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**;30 Apr 99;Build 1
- +2 ;
- +3 ;Reference to OPTION (#19) file supported by IA #10075
- +4 ;Reference to OPTION SCHEDULING (#19.2) file supported by IA #3599
- +5 ;Reference to ^DPT("AICNL" supported by IA #2070
- +6 ;Reference to $$SEND^VAFHUTL for file DG(43 supported by IA #2624
- +7 ;Reference to ^HLCS(870 supported by IA #3335
- +8 ;Reference to $$STAT^HLCSLM supported by IA #3574
- +9 ;Reference to ^DIA(2 and data derived from the AUDIT file (#1.1)
- +10 ; supported by IA #2097 and #2602.
- +11 ;Reference to ^XTV(8933.1 supported by IA #7177
- +12 ;Reference to ^XTV(8989.3 supported by IA #7183
- +13 ;
- 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 ;
- 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