Routine: RGMTUT98

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

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

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)

CNT ;do counts

 D SCORE,ICN,LICN

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTUT98   4201     printed  Mar 13, 2025@20:47:11                                                                                                                                                                                                    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

RGMTUT98.m