- 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 Mar 13, 2025@20:46:58 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)
