RGMTETOT ;BIR/CML-Compile Totals for Site Exceptions ;11/15/01
;;1.0;CLINICAL INFO RESOURCE NETWORK;**20,30,43,45,52,57**;30 Apr 99;Build 2
;
;Reference to ^DPT("AICNL" supported by IA #2070
;
;Variable RGHLMQ cannot be killed in this routine, it is needed for the remote query
;
;**57 MPIC_1893; Patch removed references to exception 218, Potential Matches Returned.
;Therefore, deleted the PURGE, SETTMP, and DELDUP modules.
;
;Use this routine to compile totals of a site's exceptions in file #991.1
S DUMP=0 G START
;
DUMP1 ;Use this call to dump all data in ascii format for table
S DUMP=1 G START
;
DUMP2 ;Use this call to dump data in ascii format for table - just for exceptions sites have to deal with
S DUMP=2
;
START ;
K TYPEARR,^XTMP("RGMT","HLMQETOT")
S ^XTMP("RGMT",0)=$$FMADD^XLFDT(DT,30)_"^"_$$NOW^XLFDT_"^MPI/PD Maintenance Data"
;create type array from file 991.11
S TYPE=233 F S TYPE=$O(^RGHL7(991.11,TYPE)) Q:'TYPE S TYPEARR(TYPE)=0 ;**52 MPIC_772 remove 215, 216, & 217;**57 MPIC_1893 remove 218 reference
;
;start loop
S TYPE=233 F S TYPE=$O(^RGHL7(991.1,"AC",TYPE)) Q:'TYPE D ;**52 MPIC_772 remove 215, 216 & 217
.S IEN1=0 F S IEN1=$O(^RGHL7(991.1,"AC",TYPE,IEN1)) Q:'IEN1 D
..S IEN2=0 F S IEN2=$O(^RGHL7(991.1,"AC",TYPE,IEN1,IEN2)) Q:'IEN2 D
...I '$D(^RGHL7(991.1,IEN1,1,IEN2,0)) Q
...S STAT=$P(^RGHL7(991.1,IEN1,1,IEN2,0),"^",5) I STAT<1 S TYPEARR(TYPE)=TYPEARR(TYPE)+1
;
PRT ;
S GRAND=0
S SITENM=$P($$SITE^VASITE(),"^",2),$P(LN,"-",81)=""
D NOW^%DTC S RUNDT=$$FMTE^XLFDT($E(%,1,12))
;
PRT0 I 'DUMP D
.W !!,"Exception Totals for ",SITENM
.W !,"Printed ",RUNDT,!,LN
.S TYPE=0 F S TYPE=$O(TYPEARR(TYPE)) Q:'TYPE I +TYPEARR(TYPE) D
..S GRAND=GRAND+TYPEARR(TYPE)
..W !!,"TYPE: ",TYPE,?12,$P($T(@TYPE),";;",2),?67,"TOTAL = ",$J(TYPEARR(TYPE),4)
..W !,"DESCRIPTION:"
..S TXT=0 F S TXT=$O(^RGHL7(991.11,TYPE,99,TXT)) Q:'TXT W !,^RGHL7(991.11,TYPE,99,TXT,0)
.W !!?56,"TOTAL EXCEPTIONS: ",$J(GRAND,5)
;
PRT1 I DUMP=1 D
.W !!,"At this point it is necessary for you to increase the right margin."
.W !,"At the DEVICE prompt enter=> ;255"
.W ! D ^%ZIS I POP W !,"DOWNLOAD ABORTED!" Q
.W !!,"Data string=Site;Run Date;Date CIRN Installed;Exceptions 234" ;**52 MPIC_772 remove 215, 216 & 217;**57 MPIC_1893 remove 218
.S STR=SITENM_";"_RUNDT_";"
.S TYPE=0 F S TYPE=$O(TYPEARR(TYPE)) Q:'TYPE D
..S STR=STR_";"_TYPEARR(TYPE)
.W !!,STR
;
PRT2 I DUMP=2 D
.S ICN=0,LOCCNT=0 F S ICN=$O(^DPT("AICNL",1,ICN)) Q:'ICN S LOCCNT=LOCCNT+1
.S SITEIEN=+$$SITE^VASITE(),STANUM=$P($$SITE^VASITE(),"^",3)
.I '$D(RGHLMQ) W !!,"Data string:"
.I '$D(RGHLMQ) W !,"Site;Sta#;;;LocICNs,234" ;**52 MPIC_772 remove 215, 216 & 217;**57 MPIC_1893 remove 218
.S STR=SITENM_";"_STANUM_";;;"_LOCCNT
.F TYPE=234 S STR=STR_";;"_TYPEARR(TYPE) ;**52 MPIC_772 remove 215, 216 & 217;**57 MPIC_1893 remove 218
.I '$D(RGHLMQ) W !!,STR
.I $D(RGHLMQ) S ^XTMP("RGMT","HLMQETOT",STANUM,1)=STR
;
QUIT ;
K %,CIRNIEN,CNT,DA,DIK,DUMP,DUPCNT,EXCDT,GRAND,ICN,IEN,IEN1,IEN2,LN,LOCCNT,OLDDT,OLDNODE,PTNM
K RGDFN,RUNDT,SITEIEN,SITENM,STANUM,STAT,STR,TXT,TYPE,XCNT,HOME,DFN,RCNT,VADM
K ^XTMP("RGMT","ETOT")
Q
;
234 ;;(Primary View Reject)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTETOT 3252 printed Dec 13, 2024@01:42:19 Page 2
RGMTETOT ;BIR/CML-Compile Totals for Site Exceptions ;11/15/01
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**20,30,43,45,52,57**;30 Apr 99;Build 2
+2 ;
+3 ;Reference to ^DPT("AICNL" supported by IA #2070
+4 ;
+5 ;Variable RGHLMQ cannot be killed in this routine, it is needed for the remote query
+6 ;
+7 ;**57 MPIC_1893; Patch removed references to exception 218, Potential Matches Returned.
+8 ;Therefore, deleted the PURGE, SETTMP, and DELDUP modules.
+9 ;
+10 ;Use this routine to compile totals of a site's exceptions in file #991.1
+11 SET DUMP=0
GOTO START
+12 ;
DUMP1 ;Use this call to dump all data in ascii format for table
+1 SET DUMP=1
GOTO START
+2 ;
DUMP2 ;Use this call to dump data in ascii format for table - just for exceptions sites have to deal with
+1 SET DUMP=2
+2 ;
START ;
+1 KILL TYPEARR,^XTMP("RGMT","HLMQETOT")
+2 SET ^XTMP("RGMT",0)=$$FMADD^XLFDT(DT,30)_"^"_$$NOW^XLFDT_"^MPI/PD Maintenance Data"
+3 ;create type array from file 991.11
+4 ;**52 MPIC_772 remove 215, 216, & 217;**57 MPIC_1893 remove 218 reference
SET TYPE=233
FOR
SET TYPE=$ORDER(^RGHL7(991.11,TYPE))
if 'TYPE
QUIT
SET TYPEARR(TYPE)=0
+5 ;
+6 ;start loop
+7 ;**52 MPIC_772 remove 215, 216 & 217
SET TYPE=233
FOR
SET TYPE=$ORDER(^RGHL7(991.1,"AC",TYPE))
if 'TYPE
QUIT
Begin DoDot:1
+8 SET IEN1=0
FOR
SET IEN1=$ORDER(^RGHL7(991.1,"AC",TYPE,IEN1))
if 'IEN1
QUIT
Begin DoDot:2
+9 SET IEN2=0
FOR
SET IEN2=$ORDER(^RGHL7(991.1,"AC",TYPE,IEN1,IEN2))
if 'IEN2
QUIT
Begin DoDot:3
+10 IF '$DATA(^RGHL7(991.1,IEN1,1,IEN2,0))
QUIT
+11 SET STAT=$PIECE(^RGHL7(991.1,IEN1,1,IEN2,0),"^",5)
IF STAT<1
SET TYPEARR(TYPE)=TYPEARR(TYPE)+1
End DoDot:3
End DoDot:2
End DoDot:1
+12 ;
PRT ;
+1 SET GRAND=0
+2 SET SITENM=$PIECE($$SITE^VASITE(),"^",2)
SET $PIECE(LN,"-",81)=""
+3 DO NOW^%DTC
SET RUNDT=$$FMTE^XLFDT($EXTRACT(%,1,12))
+4 ;
PRT0 IF 'DUMP
Begin DoDot:1
+1 WRITE !!,"Exception Totals for ",SITENM
+2 WRITE !,"Printed ",RUNDT,!,LN
+3 SET TYPE=0
FOR
SET TYPE=$ORDER(TYPEARR(TYPE))
if 'TYPE
QUIT
IF +TYPEARR(TYPE)
Begin DoDot:2
+4 SET GRAND=GRAND+TYPEARR(TYPE)
+5 WRITE !!,"TYPE: ",TYPE,?12,$PIECE($TEXT(@TYPE),";;",2),?67,"TOTAL = ",$JUSTIFY(TYPEARR(TYPE),4)
+6 WRITE !,"DESCRIPTION:"
+7 SET TXT=0
FOR
SET TXT=$ORDER(^RGHL7(991.11,TYPE,99,TXT))
if 'TXT
QUIT
WRITE !,^RGHL7(991.11,TYPE,99,TXT,0)
End DoDot:2
+8 WRITE !!?56,"TOTAL EXCEPTIONS: ",$JUSTIFY(GRAND,5)
End DoDot:1
+9 ;
PRT1 IF DUMP=1
Begin DoDot:1
+1 WRITE !!,"At this point it is necessary for you to increase the right margin."
+2 WRITE !,"At the DEVICE prompt enter=> ;255"
+3 WRITE !
DO ^%ZIS
IF POP
WRITE !,"DOWNLOAD ABORTED!"
QUIT
+4 ;**52 MPIC_772 remove 215, 216 & 217;**57 MPIC_1893 remove 218
WRITE !!,"Data string=Site;Run Date;Date CIRN Installed;Exceptions 234"
+5 SET STR=SITENM_";"_RUNDT_";"
+6 SET TYPE=0
FOR
SET TYPE=$ORDER(TYPEARR(TYPE))
if 'TYPE
QUIT
Begin DoDot:2
+7 SET STR=STR_";"_TYPEARR(TYPE)
End DoDot:2
+8 WRITE !!,STR
End DoDot:1
+9 ;
PRT2 IF DUMP=2
Begin DoDot:1
+1 SET ICN=0
SET LOCCNT=0
FOR
SET ICN=$ORDER(^DPT("AICNL",1,ICN))
if 'ICN
QUIT
SET LOCCNT=LOCCNT+1
+2 SET SITEIEN=+$$SITE^VASITE()
SET STANUM=$PIECE($$SITE^VASITE(),"^",3)
+3 IF '$DATA(RGHLMQ)
WRITE !!,"Data string:"
+4 ;**52 MPIC_772 remove 215, 216 & 217;**57 MPIC_1893 remove 218
IF '$DATA(RGHLMQ)
WRITE !,"Site;Sta#;;;LocICNs,234"
+5 SET STR=SITENM_";"_STANUM_";;;"_LOCCNT
+6 ;**52 MPIC_772 remove 215, 216 & 217;**57 MPIC_1893 remove 218
FOR TYPE=234
SET STR=STR_";;"_TYPEARR(TYPE)
+7 IF '$DATA(RGHLMQ)
WRITE !!,STR
+8 IF $DATA(RGHLMQ)
SET ^XTMP("RGMT","HLMQETOT",STANUM,1)=STR
End DoDot:1
+9 ;
QUIT ;
+1 KILL %,CIRNIEN,CNT,DA,DIK,DUMP,DUPCNT,EXCDT,GRAND,ICN,IEN,IEN1,IEN2,LN,LOCCNT,OLDDT,OLDNODE,PTNM
+2 KILL RGDFN,RUNDT,SITEIEN,SITENM,STANUM,STAT,STR,TXT,TYPE,XCNT,HOME,DFN,RCNT,VADM
+3 KILL ^XTMP("RGMT","ETOT")
+4 QUIT
+5 ;
234 ;;(Primary View Reject)
