RGMTUT98 ;BIR/CML,PTD-Misc. MPI Load COUNTER Utilities ;07/30/02
;;1.0;CLINICAL INFO RESOURCE NETWORK;**20**;30 Apr 99
;
;Reference to ^HLMA("AC" and other fields supported by IA #3273
;Reference to ^HLCS(870 supported by IA #3335
;Reference to ^VAT(391.71,"AXMIT" supported by IA #3422
;Reference to ^ORD(101 supported by IA #2596
;Reference to ^DPT("AICN", "AICNL", and "ACMORS" supported by IA #2070
;
HLMA1 ;check the contents of the ^HLMA("AC" xref - brief data
S FLG=0 G HLMA
HLMA2 ;check the contents of the ^HLMA("AC" xref - detailed data
S FLG=1
HLMA ;
K ^XTMP("RGMT","HLMQHLMA"),MISSP
S LOCSITE=$P($$SITE^VASITE(),"^",3),TXTCNT=0
D NOW^%DTC
S TXT="<<Run - "_$$FMTE^XLFDT(%)_">>"
I $D(RGHLMQ) D
.S TXTCNT=TXTCNT+1
.S ^XTMP("RGMT","HLMQHLMA",LOCSITE,"@@ RUNDATE")=$$FMTE^XLFDT($E(%,1,12))
.S ^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT
I '$D(RGHLMQ) W !,TXT
;
S TXT="Outgoing messages:"
I $D(RGHLMQ) S TXTCNT=TXTCNT+1,^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT
I '$D(RGHLMQ) W !,TXT
;
S SITE=0
F S SITE=$O(^HLMA("AC","O",SITE)) Q:'SITE D I $D(CNT) D WRT
.K CNT
.S LINK=$$GET1^DIQ(870,SITE_",",.01) I $E(LINK,1,2)'="VA"&($E(LINK,1,2)'="MP") S QFLG=1 Q
.K ARR
.S MSG=0,CNT=0
.F S MSG=$O(^HLMA("AC","O",SITE,MSG)) Q:'MSG D
..S CNT=CNT+1
..Q:'FLG
..S PROT=$$GET1^DIQ(773,MSG_",",8,"I")
..Q:'PROT
..I '$D(ARR(PROT)) S ARR(PROT)=0
..S ARR(PROT)=ARR(PROT)+1
;
S TXT=""
I $D(RGHLMQ) S TXTCNT=TXTCNT+1,^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT
I '$D(RGHLMQ) W !,TXT
;
S TXT="Incoming messages:"
I $D(RGHLMQ) S TXTCNT=TXTCNT+1,^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT
I '$D(RGHLMQ) W !,TXT
S SITE=0
F S SITE=$O(^HLMA("AC","I",SITE)) Q:'SITE D D WRT
.K ARR
.S MSG=0,CNT=0
.F S MSG=$O(^HLMA("AC","I",SITE,MSG)) Q:'MSG D
..S CNT=CNT+1
..Q:'FLG
..S PROT=$$GET1^DIQ(773,MSG_",",8,"I")
..Q:'PROT
..I '$D(ARR(PROT)) S ARR(PROT)=0
..S ARR(PROT)=ARR(PROT)+1
;
QUIT K SITE,CNT,MSG,PROT,PROTNM,ARR,LINKNM,MISSP,MSG,GOT,INFLR
K FLG,LINK,LOCSITE,QFLG,STATE,TXT1,TXT2,TXTCNT
Q
;
PIV ;Count # of entries in pivot file xref
S CNT=0,IEN=0 F S IEN=$O(^VAT(391.71,"AXMIT",4,IEN)) Q:'IEN S CNT=CNT+1
S TXT="(Total DATA UPDATES waiting to be processed = "_CNT_")"
I $D(RGHLMQ) S TXTCNT=TXTCNT+1,^XTMP("RGMT","HLMQMONT",LOCSITE,TXTCNT)=TXT
I '$D(RGHLMQ) W !?3,TXT
S CNT=0,IEN=0 F S IEN=$O(^VAT(391.71,"AXMIT",5,IEN)) Q:'IEN S CNT=CNT+1
S TXT="(Total TREATING FACILITY UPDATES waiting to be processed = "_CNT_")"
I $D(RGHLMQ) S TXTCNT=TXTCNT+1,^XTMP("RGMT","HLMQMONT",LOCSITE,TXTCNT)=TXT
I '$D(RGHLMQ) W !?3,TXT
K CNT,IEN,TXT
Q
;
WRT ;write type and total for messages
;find current STATE of Link
S STATE=$$GET1^DIQ(870,SITE_",",4)
S TXT1=$$GET1^DIQ(870,SITE_",",.01)_" - "_CNT_" messages"_$S(FLG:":",1:".")
S TXT2="STATE: "_STATE
I $D(RGHLMQ) S TXTCNT=TXTCNT+1,^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT1_" "_TXT2
I '$D(RGHLMQ) W !,TXT1,?30,TXT2
Q:'FLG
S PROT=0
F S PROT=$O(ARR(PROT)) Q:'PROT D
.S PROTNM=$P($G(^ORD(101,PROT,0)),"^") I PROTNM="" S PROTNM="PROTOCOL NOT FOUND"
.I $D(RGHLMQ) S TXTCNT=TXTCNT+1,TXT=PROTNM_" - "_ARR(PROT),^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT
.I '$D(RGHLMQ) W !?3,PROTNM,?32," - ",$J(ARR(PROT),8)
Q
;
CNT ;do counts
D SCORE,ICN,LICN
Q
SCORE ;count number of CMOR scores
D NOW^%DTC
W !,"<<Run - ",$$FMTE^XLFDT(%),">>"
W !,"...counting number of CMOR scores"
S SC=0,CNT=0
F S SC=$O(^DPT("ACMORS",SC)) Q:'SC D
.S DFN=0
.F S DFN=$O(^DPT("ACMORS",SC,DFN)) Q:'DFN D
..S CNT=CNT+1
W !?3,"(Current total # of Patients with CMOR Scores = ",CNT,")"
K %,SC,CNT,DFN
Q
;
ICN ;count number of ICNs
S HOME=$P($$SITE^VASITE(),"^",3)
W !!,"...counting number of ICNs"
S ICN=0,CNT=0
F S ICN=$O(^DPT("AICN",ICN)) Q:'ICN D
.Q:$E(ICN,1,3)=HOME
.S CNT=CNT+1
W !?3,"(Current total # of National ICNs = ",CNT,")"
K HOME,ICN,CNT
Q
;
LICN ;count number of local ICNs
W !!,"...counting number of local ICNs"
S ICN=0,CNT=0
F S ICN=$O(^DPT("AICNL",1,ICN)) Q:'ICN S CNT=CNT+1
W !?3,"(Current total # of Local ICNs = ",CNT,")"
K CNT,DFN,ICN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTUT98 4201 printed Oct 16, 2024@17:43:23 Page 2
RGMTUT98 ;BIR/CML,PTD-Misc. MPI Load COUNTER Utilities ;07/30/02
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**20**;30 Apr 99
+2 ;
+3 ;Reference to ^HLMA("AC" and other fields supported by IA #3273
+4 ;Reference to ^HLCS(870 supported by IA #3335
+5 ;Reference to ^VAT(391.71,"AXMIT" supported by IA #3422
+6 ;Reference to ^ORD(101 supported by IA #2596
+7 ;Reference to ^DPT("AICN", "AICNL", and "ACMORS" supported by IA #2070
+8 ;
HLMA1 ;check the contents of the ^HLMA("AC" xref - brief data
+1 SET FLG=0
GOTO HLMA
HLMA2 ;check the contents of the ^HLMA("AC" xref - detailed data
+1 SET FLG=1
HLMA ;
+1 KILL ^XTMP("RGMT","HLMQHLMA"),MISSP
+2 SET LOCSITE=$PIECE($$SITE^VASITE(),"^",3)
SET TXTCNT=0
+3 DO NOW^%DTC
+4 SET TXT="<<Run - "_$$FMTE^XLFDT(%)_">>"
+5 IF $DATA(RGHLMQ)
Begin DoDot:1
+6 SET TXTCNT=TXTCNT+1
+7 SET ^XTMP("RGMT","HLMQHLMA",LOCSITE,"@@ RUNDATE")=$$FMTE^XLFDT($EXTRACT(%,1,12))
+8 SET ^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT
End DoDot:1
+9 IF '$DATA(RGHLMQ)
WRITE !,TXT
+10 ;
+11 SET TXT="Outgoing messages:"
+12 IF $DATA(RGHLMQ)
SET TXTCNT=TXTCNT+1
SET ^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT
+13 IF '$DATA(RGHLMQ)
WRITE !,TXT
+14 ;
+15 SET SITE=0
+16 FOR
SET SITE=$ORDER(^HLMA("AC","O",SITE))
if 'SITE
QUIT
Begin DoDot:1
+17 KILL CNT
+18 SET LINK=$$GET1^DIQ(870,SITE_",",.01)
IF $EXTRACT(LINK,1,2)'="VA"&($EXTRACT(LINK,1,2)'="MP")
SET QFLG=1
QUIT
+19 KILL ARR
+20 SET MSG=0
SET CNT=0
+21 FOR
SET MSG=$ORDER(^HLMA("AC","O",SITE,MSG))
if 'MSG
QUIT
Begin DoDot:2
+22 SET CNT=CNT+1
+23 if 'FLG
QUIT
+24 SET PROT=$$GET1^DIQ(773,MSG_",",8,"I")
+25 if 'PROT
QUIT
+26 IF '$DATA(ARR(PROT))
SET ARR(PROT)=0
+27 SET ARR(PROT)=ARR(PROT)+1
End DoDot:2
End DoDot:1
IF $DATA(CNT)
DO WRT
+28 ;
+29 SET TXT=""
+30 IF $DATA(RGHLMQ)
SET TXTCNT=TXTCNT+1
SET ^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT
+31 IF '$DATA(RGHLMQ)
WRITE !,TXT
+32 ;
+33 SET TXT="Incoming messages:"
+34 IF $DATA(RGHLMQ)
SET TXTCNT=TXTCNT+1
SET ^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT
+35 IF '$DATA(RGHLMQ)
WRITE !,TXT
+36 SET SITE=0
+37 FOR
SET SITE=$ORDER(^HLMA("AC","I",SITE))
if 'SITE
QUIT
Begin DoDot:1
+38 KILL ARR
+39 SET MSG=0
SET CNT=0
+40 FOR
SET MSG=$ORDER(^HLMA("AC","I",SITE,MSG))
if 'MSG
QUIT
Begin DoDot:2
+41 SET CNT=CNT+1
+42 if 'FLG
QUIT
+43 SET PROT=$$GET1^DIQ(773,MSG_",",8,"I")
+44 if 'PROT
QUIT
+45 IF '$DATA(ARR(PROT))
SET ARR(PROT)=0
+46 SET ARR(PROT)=ARR(PROT)+1
End DoDot:2
End DoDot:1
DO WRT
+47 ;
QUIT KILL SITE,CNT,MSG,PROT,PROTNM,ARR,LINKNM,MISSP,MSG,GOT,INFLR
+1 KILL FLG,LINK,LOCSITE,QFLG,STATE,TXT1,TXT2,TXTCNT
+2 QUIT
+3 ;
PIV ;Count # of entries in pivot file xref
+1 SET CNT=0
SET IEN=0
FOR
SET IEN=$ORDER(^VAT(391.71,"AXMIT",4,IEN))
if 'IEN
QUIT
SET CNT=CNT+1
+2 SET TXT="(Total DATA UPDATES waiting to be processed = "_CNT_")"
+3 IF $DATA(RGHLMQ)
SET TXTCNT=TXTCNT+1
SET ^XTMP("RGMT","HLMQMONT",LOCSITE,TXTCNT)=TXT
+4 IF '$DATA(RGHLMQ)
WRITE !?3,TXT
+5 SET CNT=0
SET IEN=0
FOR
SET IEN=$ORDER(^VAT(391.71,"AXMIT",5,IEN))
if 'IEN
QUIT
SET CNT=CNT+1
+6 SET TXT="(Total TREATING FACILITY UPDATES waiting to be processed = "_CNT_")"
+7 IF $DATA(RGHLMQ)
SET TXTCNT=TXTCNT+1
SET ^XTMP("RGMT","HLMQMONT",LOCSITE,TXTCNT)=TXT
+8 IF '$DATA(RGHLMQ)
WRITE !?3,TXT
+9 KILL CNT,IEN,TXT
+10 QUIT
+11 ;
WRT ;write type and total for messages
+1 ;find current STATE of Link
+2 SET STATE=$$GET1^DIQ(870,SITE_",",4)
+3 SET TXT1=$$GET1^DIQ(870,SITE_",",.01)_" - "_CNT_" messages"_$SELECT(FLG:":",1:".")
+4 SET TXT2="STATE: "_STATE
+5 IF $DATA(RGHLMQ)
SET TXTCNT=TXTCNT+1
SET ^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT1_" "_TXT2
+6 IF '$DATA(RGHLMQ)
WRITE !,TXT1,?30,TXT2
+7 if 'FLG
QUIT
+8 SET PROT=0
+9 FOR
SET PROT=$ORDER(ARR(PROT))
if 'PROT
QUIT
Begin DoDot:1
+10 SET PROTNM=$PIECE($GET(^ORD(101,PROT,0)),"^")
IF PROTNM=""
SET PROTNM="PROTOCOL NOT FOUND"
+11 IF $DATA(RGHLMQ)
SET TXTCNT=TXTCNT+1
SET TXT=PROTNM_" - "_ARR(PROT)
SET ^XTMP("RGMT","HLMQHLMA",LOCSITE,TXTCNT)=TXT
+12 IF '$DATA(RGHLMQ)
WRITE !?3,PROTNM,?32," - ",$JUSTIFY(ARR(PROT),8)
End DoDot:1
+13 QUIT
+14 ;
CNT ;do counts
+1 DO SCORE
DO ICN
DO LICN
+2 QUIT
SCORE ;count number of CMOR scores
+1 DO NOW^%DTC
+2 WRITE !,"<<Run - ",$$FMTE^XLFDT(%),">>"
+3 WRITE !,"...counting number of CMOR scores"
+4 SET SC=0
SET CNT=0
+5 FOR
SET SC=$ORDER(^DPT("ACMORS",SC))
if 'SC
QUIT
Begin DoDot:1
+6 SET DFN=0
+7 FOR
SET DFN=$ORDER(^DPT("ACMORS",SC,DFN))
if 'DFN
QUIT
Begin DoDot:2
+8 SET CNT=CNT+1
End DoDot:2
End DoDot:1
+9 WRITE !?3,"(Current total # of Patients with CMOR Scores = ",CNT,")"
+10 KILL %,SC,CNT,DFN
+11 QUIT
+12 ;
ICN ;count number of ICNs
+1 SET HOME=$PIECE($$SITE^VASITE(),"^",3)
+2 WRITE !!,"...counting number of ICNs"
+3 SET ICN=0
SET CNT=0
+4 FOR
SET ICN=$ORDER(^DPT("AICN",ICN))
if 'ICN
QUIT
Begin DoDot:1
+5 if $EXTRACT(ICN,1,3)=HOME
QUIT
+6 SET CNT=CNT+1
End DoDot:1
+7 WRITE !?3,"(Current total # of National ICNs = ",CNT,")"
+8 KILL HOME,ICN,CNT
+9 QUIT
+10 ;
LICN ;count number of local ICNs
+1 WRITE !!,"...counting number of local ICNs"
+2 SET ICN=0
SET CNT=0
+3 FOR
SET ICN=$ORDER(^DPT("AICNL",1,ICN))
if 'ICN
QUIT
SET CNT=CNT+1
+4 WRITE !?3,"(Current total # of Local ICNs = ",CNT,")"
+5 KILL CNT,DFN,ICN
+6 QUIT
