- KMPDHUA ;OAK/RAK - Remote Synchronous HL7 Protocol ;3/15/04 07:48
- ;;3.0;KMPD;;Jan 22, 2009;Build 42
- ;
- EN ;-entry point
- ;
- N DIC,I,KMPDATE,KMPDNMSP,KMPDPROT,KMPDSRCH,POP,X,Y
- N ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
- ;
- ; option header
- D HDR^KMPDUTL4(" Synchronous Remote Protocol Distribution ") W !!
- ; select protocol
- S DIC=101,DIC(0)="AELMQZ",DIC("A")="Select Protocol: "
- D ^DIC Q:(+Y)<0 S KMPDPROT=Y
- ;
- ; select namespace (package file)
- D NMSPARRY(.KMPDNMSP) Q:'$D(KMPDNMSP)
- ;
- ; select date range
- D DATERNG^KMPDUTL2(.KMPDATE) Q:'KMPDATE
- ;
- ; element to rate protocols
- K DIR
- S DIR(0)="SO^1:Message Size;2:Character Transmission Rate;3:Message Transmission Rate"
- S DIR("B")=1
- D ^DIR Q:$G(Y)=""!($G(Y)="^")
- S KMPDSRCH=$S(Y:Y_"^"_$G(Y(0)),1:Y)
- ;
- ; select output device.
- S %ZIS="Q",%ZIS("A")="Device: ",%ZIS("B")="HOME"
- W ! D ^%ZIS I POP W !,"No action taken." Q
- ; if queued.
- I $D(IO("Q")) K IO("Q") D Q
- .S ZTDESC="Synchronous Distribution Report"
- .S ZTRTN="EN1^KMPDHUA"
- .F I="KMPDATE","KMPDNMSP","KMPDPROT","KMPDSRCH" S ZTSAVE(I)=""
- .D ^%ZTLOAD W:$G(ZTSK) !,"Task #",ZTSK
- .D EXIT
- ;
- D EN1
- ;
- Q
- ;
- EN1 ;-- entry point from taskman
- ;
- Q:'$G(KMPDATE)
- Q:'$D(KMPDNMSP)
- Q:'$G(KMPDSRCH)
- ;
- N END,ERROR,STR,X
- ;
- S STR=$P(KMPDATE,U),END=$P(KMPDATE,U,2)
- Q:'STR!('END)
- ;
- ; get data from hl7 api
- W:'$D(ZTQUEUED) !,"Gathering HL7 data..."
- K ^TMP("KMPDH",$J),^TMP("KMPDH-1",$J)
- ;
- D DATA,PRINT,EXIT
- ;
- Q
- ;
- DATA ;
- ; if 'all' namespaces
- I $G(KMPDNMSP(0))="*" D
- .S X=$$CMF^HLUCM(STR,END,1,KMPDPROT,"KMPDH","EITHER",.ERROR)
- ; if 'specific' namespaces
- E D
- .S X=$$CMF^HLUCM(STR,END,.KMPDNMSP,KMPDPROT,"KMPDH","BOTH",.ERROR)
- ;
- ; determine search list
- S FAC=""
- F S FAC=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC)) Q:FAC="" D
- .S NMSP=""
- .F S NMSP=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC,NMSP)) Q:NMSP="" S TOT=^(NMSP) D
- ..; 1 - message size = chr/message
- ..; 2 - charater transmission rate - chr/sec/msg
- ..; 3 - message transmission rate - sec/msg
- ..S SRCH=""
- ..I (+KMPDSRCH)=1 S SRCH=$P(TOT,U)/$P(TOT,U,2)
- ..I (+KMPDSRCH)=2 S SRCH=($P(TOT,U)/$P(TOT,U,3))/$P(TOT,U,2)
- ..I (+KMPDSRCH)=3 S SRCH=$P(TOT,U,3)/$P(TOT,U,2)
- ..Q:SRCH=""
- ..S ^TMP("KMPDH-1",$J,SRCH,FAC,NMSP)=""
- ;
- Q
- ;
- EXIT ;
- S:$D(ZTQUEUED) ZTREQ="@"
- K KMPDATE,KMPDNMSP,KMPDPROT,KMPDSRCH
- K ^TMP("KMPDH",$J),^TMP("KMPDH-1",$J)
- D ^%ZISC
- Q
- ;
- PRINT ;-- print sync/facility data
- N DATA,DATE,FAC,I,J,NMSP,PROT,RANK,SRCH
- D HDR
- I '$D(^TMP("KMPDH-1",$J)) W !?5," No Data to Report" Q
- S SRCH="A",RANK=1
- F S SRCH=$O(^TMP("KMPDH-1",$J,SRCH),-1) Q:'SRCH D
- .W !,RANK,".",?5,$J($FN(SRCH,",",$S((+KMPDSRCH)=3:2,1:0)),10)
- .S FAC="",RANK=RANK+1
- .F S FAC=$O(^TMP("KMPDH-1",$J,SRCH,FAC)) Q:FAC="" D
- ..W ?17,$E($P(FAC,"~",2),1,18) S NMSP=""
- ..F S NMSP=$O(^TMP("KMPDH-1",$J,SRCH,FAC,NMSP)) Q:NMSP="" D
- ...W ?37,NMSP S DATE=0 K TOT
- ...F S DATE=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC,NMSP,DATE)) Q:'DATE D
- ....S PROT=""
- ....F S PROT=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC,NMSP,DATE,PROT)) Q:PROT="" S DATA=^(PROT) D
- .....; tcp/mail/unknown
- .....S DATA("T")=$G(^TMP("KMPDH",$J,"HR","TM","T",FAC,DATE,NMSP,PROT))
- .....S DATA("M")=$G(^TMP("KMPDH",$J,"HR","TM","M",FAC,DATE,NMSP,PROT))
- .....S DATA("TMU")=$G(^TMP("KMPDH",$J,"HR","TM","U",FAC,DATE,NMSP,PROT))
- .....; incoming/outgoing/unknown
- .....S DATA("I")=$G(^TMP("KMPDH",$J,"NMSP","IO","I",FAC,NMSP,DATE,PROT))
- .....S DATA("O")=$G(^TMP("KMPDH",$J,"NMSP","IO","O",FAC,NMSP,DATE,PROT))
- .....S DATA("IOU")=$G(^TMP("KMPDH",$J,"NMSP","IO","U",FAC,NMSP,DATE,PROT))
- .....; calculate sub-totals
- .....F I=1:1:3 D
- ......S $P(TOT,U,I)=$P($G(TOT),U,I)+$P(DATA,U,I)
- ......S $P(TOT("T"),U,I)=$P($G(TOT("T")),U,I)+$P(DATA("T"),U,I)
- ......S $P(TOT("M"),U,I)=$P($G(TOT("M")),U,I)+$P(DATA("M"),U,I)
- ......S $P(TOT("TMU"),U,I)=$P($G(TOT("TMU")),U,I)+$P(DATA("TMU"),U,I)
- ......S $P(TOT("I"),U,I)=$P($G(TOT("I")),U,I)+$P(DATA("I"),U,I)
- ......S $P(TOT("O"),U,I)=$P($G(TOT("O")),U,I)+$P(DATA("O"),U,I)
- ......S $P(TOT("IOU"),U,I)=$P($G(TOT("IOU")),U,I)+$P(DATA("IOU"),U,I)
- ...;
- ...; back to NMSP level
- ...;
- ...W ?45,$J($FN($P(TOT,U),",",0),9)
- ...W ?56,$J($FN($P(TOT,U,2),",",0),9)
- ...W ?67,$J($FN($P(TOT,U,3),",",0),9)
- ...W !
- ...F I="T","M","TMU","I","O","IOU" D
- ....W ! W:I="I"!(I="L") !
- ....W ?21,$S(I="T":"TCP",I="M":"Mail",I="TMU":"T/M Unknown",1:"")
- ....W ?21,$S(I="I":"Incoming",I="O":"Outgoing",I="IOU":"I/O Unknown",1:"")
- ....F J=1:1:3 W ?$S(J=1:45,J=2:56,1:67),$J($FN($P($G(TOT(I)),U,J),",",0),9)
- ..W !
- ;
- Q
- ;
- HDR ;
- S KMPDATE=$G(KMPDATE)
- S KMPDPROT=$G(KMPDPROT)
- S KMPDSRCH=$G(KMPDSRCH)
- W @IOF
- N X
- S X=$$SITE^VASITE,X=$P(X,U,2)_" ("_$P(X,U)_")"
- W !?(80-$L(X)\2),X,?62,"Printed: ",$$FMTE^XLFDT(DT,2)
- W !?21,"Synchronous Remote Protocol Distribution"
- S X="'"_$P(KMPDPROT,"^",2)_"'"
- W !?((80-$L(X))\2),X
- S X=$P($P(KMPDATE,U,3),"@")_": "_$P($P(KMPDATE,U,3),"@",2)
- S X=X_" - "_$P($P(KMPDATE,U,4),"@")_": "_$P($P(KMPDATE,U,4),"@",2)
- W !?(80-$L(X)\2),X
- S X=$P(KMPDSRCH,U)_" - "_$P(KMPDSRCH,U,2)
- W !?((80-$L(X))\2),X
- S X=$S((+KMPDSRCH)=1:" Chr/Msg",(+KMPDSRCH)=2:"Ch/Sc/Mg",(+KMPDSRCH)=3:" Sec/Msg",1:"OTHER")
- W !
- W !,"Rank",?6,X,?17,"Remote Facility",?37,"Nmsp",?45,$J("Chrs",9),?56,$J("Messages",9),?67,$J("Seconds",9)
- W !,"----",?6,"---------",?17,"------------------",?37,"----",?45,"---------",?56,"---------",?67,"---------"
- ;
- Q
- ;
- NMSPARRY(KMPDNMSP) ;-- namespace arry
- K KMPDNMSP
- N DIC,NM1,NMSP,PKG,X,Y
- S DIC=9.4,DIC(0)="AEMQZ",DIC("A")="Select Namespace: "
- W ! D SELECT^KMPDUT4("KMPDNMSP",1,5)
- Q:$G(KMPDNMSP(0))=""
- Q:KMPDNMSP(0)'="*"&($O(KMPDNMSP(0))="")
- I KMPDNMSP(0)'="*" K KMPDNMSP(0),NM1 D
- .S I="" F S I=$O(KMPDNMSP(I)) Q:I="" S PKG=KMPDNMSP(I) D:PKG
- ..S NMSP=$P($G(^DIC(9.4,PKG,0)),U,2)
- ..S:NMSP'="" NM1(NMSP)=PKG
- ..K KMPDNMSP(I)
- .M KMPDNMSP=NM1
- ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDHUA 5952 printed Feb 18, 2025@23:06:59 Page 2
- KMPDHUA ;OAK/RAK - Remote Synchronous HL7 Protocol ;3/15/04 07:48
- +1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
- +2 ;
- EN ;-entry point
- +1 ;
- +2 NEW DIC,I,KMPDATE,KMPDNMSP,KMPDPROT,KMPDSRCH,POP,X,Y
- +3 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
- +4 ;
- +5 ; option header
- +6 DO HDR^KMPDUTL4(" Synchronous Remote Protocol Distribution ")
- WRITE !!
- +7 ; select protocol
- +8 SET DIC=101
- SET DIC(0)="AELMQZ"
- SET DIC("A")="Select Protocol: "
- +9 DO ^DIC
- if (+Y)<0
- QUIT
- SET KMPDPROT=Y
- +10 ;
- +11 ; select namespace (package file)
- +12 DO NMSPARRY(.KMPDNMSP)
- if '$DATA(KMPDNMSP)
- QUIT
- +13 ;
- +14 ; select date range
- +15 DO DATERNG^KMPDUTL2(.KMPDATE)
- if 'KMPDATE
- QUIT
- +16 ;
- +17 ; element to rate protocols
- +18 KILL DIR
- +19 SET DIR(0)="SO^1:Message Size;2:Character Transmission Rate;3:Message Transmission Rate"
- +20 SET DIR("B")=1
- +21 DO ^DIR
- if $GET(Y)=""!($GET(Y)="^")
- QUIT
- +22 SET KMPDSRCH=$SELECT(Y:Y_"^"_$GET(Y(0)),1:Y)
- +23 ;
- +24 ; select output device.
- +25 SET %ZIS="Q"
- SET %ZIS("A")="Device: "
- SET %ZIS("B")="HOME"
- +26 WRITE !
- DO ^%ZIS
- IF POP
- WRITE !,"No action taken."
- QUIT
- +27 ; if queued.
- +28 IF $DATA(IO("Q"))
- KILL IO("Q")
- Begin DoDot:1
- +29 SET ZTDESC="Synchronous Distribution Report"
- +30 SET ZTRTN="EN1^KMPDHUA"
- +31 FOR I="KMPDATE","KMPDNMSP","KMPDPROT","KMPDSRCH"
- SET ZTSAVE(I)=""
- +32 DO ^%ZTLOAD
- if $GET(ZTSK)
- WRITE !,"Task #",ZTSK
- +33 DO EXIT
- End DoDot:1
- QUIT
- +34 ;
- +35 DO EN1
- +36 ;
- +37 QUIT
- +38 ;
- EN1 ;-- entry point from taskman
- +1 ;
- +2 if '$GET(KMPDATE)
- QUIT
- +3 if '$DATA(KMPDNMSP)
- QUIT
- +4 if '$GET(KMPDSRCH)
- QUIT
- +5 ;
- +6 NEW END,ERROR,STR,X
- +7 ;
- +8 SET STR=$PIECE(KMPDATE,U)
- SET END=$PIECE(KMPDATE,U,2)
- +9 if 'STR!('END)
- QUIT
- +10 ;
- +11 ; get data from hl7 api
- +12 if '$DATA(ZTQUEUED)
- WRITE !,"Gathering HL7 data..."
- +13 KILL ^TMP("KMPDH",$JOB),^TMP("KMPDH-1",$JOB)
- +14 ;
- +15 DO DATA
- DO PRINT
- DO EXIT
- +16 ;
- +17 QUIT
- +18 ;
- DATA ;
- +1 ; if 'all' namespaces
- +2 IF $GET(KMPDNMSP(0))="*"
- Begin DoDot:1
- +3 SET X=$$CMF^HLUCM(STR,END,1,KMPDPROT,"KMPDH","EITHER",.ERROR)
- End DoDot:1
- +4 ; if 'specific' namespaces
- +5 IF '$TEST
- Begin DoDot:1
- +6 SET X=$$CMF^HLUCM(STR,END,.KMPDNMSP,KMPDPROT,"KMPDH","BOTH",.ERROR)
- End DoDot:1
- +7 ;
- +8 ; determine search list
- +9 SET FAC=""
- +10 FOR
- SET FAC=$ORDER(^TMP("KMPDH",$JOB,"RFAC","LR","R",FAC))
- if FAC=""
- QUIT
- Begin DoDot:1
- +11 SET NMSP=""
- +12 FOR
- SET NMSP=$ORDER(^TMP("KMPDH",$JOB,"RFAC","LR","R",FAC,NMSP))
- if NMSP=""
- QUIT
- SET TOT=^(NMSP)
- Begin DoDot:2
- +13 ; 1 - message size = chr/message
- +14 ; 2 - charater transmission rate - chr/sec/msg
- +15 ; 3 - message transmission rate - sec/msg
- +16 SET SRCH=""
- +17 IF (+KMPDSRCH)=1
- SET SRCH=$PIECE(TOT,U)/$PIECE(TOT,U,2)
- +18 IF (+KMPDSRCH)=2
- SET SRCH=($PIECE(TOT,U)/$PIECE(TOT,U,3))/$PIECE(TOT,U,2)
- +19 IF (+KMPDSRCH)=3
- SET SRCH=$PIECE(TOT,U,3)/$PIECE(TOT,U,2)
- +20 if SRCH=""
- QUIT
- +21 SET ^TMP("KMPDH-1",$JOB,SRCH,FAC,NMSP)=""
- End DoDot:2
- End DoDot:1
- +22 ;
- +23 QUIT
- +24 ;
- EXIT ;
- +1 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 KILL KMPDATE,KMPDNMSP,KMPDPROT,KMPDSRCH
- +3 KILL ^TMP("KMPDH",$JOB),^TMP("KMPDH-1",$JOB)
- +4 DO ^%ZISC
- +5 QUIT
- +6 ;
- PRINT ;-- print sync/facility data
- +1 NEW DATA,DATE,FAC,I,J,NMSP,PROT,RANK,SRCH
- +2 DO HDR
- +3 IF '$DATA(^TMP("KMPDH-1",$JOB))
- WRITE !?5," No Data to Report"
- QUIT
- +4 SET SRCH="A"
- SET RANK=1
- +5 FOR
- SET SRCH=$ORDER(^TMP("KMPDH-1",$JOB,SRCH),-1)
- if 'SRCH
- QUIT
- Begin DoDot:1
- +6 WRITE !,RANK,".",?5,$JUSTIFY($FNUMBER(SRCH,",",$SELECT((+KMPDSRCH)=3:2,1:0)),10)
- +7 SET FAC=""
- SET RANK=RANK+1
- +8 FOR
- SET FAC=$ORDER(^TMP("KMPDH-1",$JOB,SRCH,FAC))
- if FAC=""
- QUIT
- Begin DoDot:2
- +9 WRITE ?17,$EXTRACT($PIECE(FAC,"~",2),1,18)
- SET NMSP=""
- +10 FOR
- SET NMSP=$ORDER(^TMP("KMPDH-1",$JOB,SRCH,FAC,NMSP))
- if NMSP=""
- QUIT
- Begin DoDot:3
- +11 WRITE ?37,NMSP
- SET DATE=0
- KILL TOT
- +12 FOR
- SET DATE=$ORDER(^TMP("KMPDH",$JOB,"RFAC","LR","R",FAC,NMSP,DATE))
- if 'DATE
- QUIT
- Begin DoDot:4
- +13 SET PROT=""
- +14 FOR
- SET PROT=$ORDER(^TMP("KMPDH",$JOB,"RFAC","LR","R",FAC,NMSP,DATE,PROT))
- if PROT=""
- QUIT
- SET DATA=^(PROT)
- Begin DoDot:5
- +15 ; tcp/mail/unknown
- +16 SET DATA("T")=$GET(^TMP("KMPDH",$JOB,"HR","TM","T",FAC,DATE,NMSP,PROT))
- +17 SET DATA("M")=$GET(^TMP("KMPDH",$JOB,"HR","TM","M",FAC,DATE,NMSP,PROT))
- +18 SET DATA("TMU")=$GET(^TMP("KMPDH",$JOB,"HR","TM","U",FAC,DATE,NMSP,PROT))
- +19 ; incoming/outgoing/unknown
- +20 SET DATA("I")=$GET(^TMP("KMPDH",$JOB,"NMSP","IO","I",FAC,NMSP,DATE,PROT))
- +21 SET DATA("O")=$GET(^TMP("KMPDH",$JOB,"NMSP","IO","O",FAC,NMSP,DATE,PROT))
- +22 SET DATA("IOU")=$GET(^TMP("KMPDH",$JOB,"NMSP","IO","U",FAC,NMSP,DATE,PROT))
- +23 ; calculate sub-totals
- +24 FOR I=1:1:3
- Begin DoDot:6
- +25 SET $PIECE(TOT,U,I)=$PIECE($GET(TOT),U,I)+$PIECE(DATA,U,I)
- +26 SET $PIECE(TOT("T"),U,I)=$PIECE($GET(TOT("T")),U,I)+$PIECE(DATA("T"),U,I)
- +27 SET $PIECE(TOT("M"),U,I)=$PIECE($GET(TOT("M")),U,I)+$PIECE(DATA("M"),U,I)
- +28 SET $PIECE(TOT("TMU"),U,I)=$PIECE($GET(TOT("TMU")),U,I)+$PIECE(DATA("TMU"),U,I)
- +29 SET $PIECE(TOT("I"),U,I)=$PIECE($GET(TOT("I")),U,I)+$PIECE(DATA("I"),U,I)
- +30 SET $PIECE(TOT("O"),U,I)=$PIECE($GET(TOT("O")),U,I)+$PIECE(DATA("O"),U,I)
- +31 SET $PIECE(TOT("IOU"),U,I)=$PIECE($GET(TOT("IOU")),U,I)+$PIECE(DATA("IOU"),U,I)
- End DoDot:6
- End DoDot:5
- End DoDot:4
- +32 ;
- +33 ; back to NMSP level
- +34 ;
- +35 WRITE ?45,$JUSTIFY($FNUMBER($PIECE(TOT,U),",",0),9)
- +36 WRITE ?56,$JUSTIFY($FNUMBER($PIECE(TOT,U,2),",",0),9)
- +37 WRITE ?67,$JUSTIFY($FNUMBER($PIECE(TOT,U,3),",",0),9)
- +38 WRITE !
- +39 FOR I="T","M","TMU","I","O","IOU"
- Begin DoDot:4
- +40 WRITE !
- if I="I"!(I="L")
- WRITE !
- +41 WRITE ?21,$SELECT(I="T":"TCP",I="M":"Mail",I="TMU":"T/M Unknown",1:"")
- +42 WRITE ?21,$SELECT(I="I":"Incoming",I="O":"Outgoing",I="IOU":"I/O Unknown",1:"")
- +43 FOR J=1:1:3
- WRITE ?$SELECT(J=1:45,J=2:56,1:67),$JUSTIFY($FNUMBER($PIECE($GET(TOT(I)),U,J),",",0),9)
- End DoDot:4
- End DoDot:3
- +44 WRITE !
- End DoDot:2
- End DoDot:1
- +45 ;
- +46 QUIT
- +47 ;
- HDR ;
- +1 SET KMPDATE=$GET(KMPDATE)
- +2 SET KMPDPROT=$GET(KMPDPROT)
- +3 SET KMPDSRCH=$GET(KMPDSRCH)
- +4 WRITE @IOF
- +5 NEW X
- +6 SET X=$$SITE^VASITE
- SET X=$PIECE(X,U,2)_" ("_$PIECE(X,U)_")"
- +7 WRITE !?(80-$LENGTH(X)\2),X,?62,"Printed: ",$$FMTE^XLFDT(DT,2)
- +8 WRITE !?21,"Synchronous Remote Protocol Distribution"
- +9 SET X="'"_$PIECE(KMPDPROT,"^",2)_"'"
- +10 WRITE !?((80-$LENGTH(X))\2),X
- +11 SET X=$PIECE($PIECE(KMPDATE,U,3),"@")_": "_$PIECE($PIECE(KMPDATE,U,3),"@",2)
- +12 SET X=X_" - "_$PIECE($PIECE(KMPDATE,U,4),"@")_": "_$PIECE($PIECE(KMPDATE,U,4),"@",2)
- +13 WRITE !?(80-$LENGTH(X)\2),X
- +14 SET X=$PIECE(KMPDSRCH,U)_" - "_$PIECE(KMPDSRCH,U,2)
- +15 WRITE !?((80-$LENGTH(X))\2),X
- +16 SET X=$SELECT((+KMPDSRCH)=1:" Chr/Msg",(+KMPDSRCH)=2:"Ch/Sc/Mg",(+KMPDSRCH)=3:" Sec/Msg",1:"OTHER")
- +17 WRITE !
- +18 WRITE !,"Rank",?6,X,?17,"Remote Facility",?37,"Nmsp",?45,$JUSTIFY("Chrs",9),?56,$JUSTIFY("Messages",9),?67,$JUSTIFY("Seconds",9)
- +19 WRITE !,"----",?6,"---------",?17,"------------------",?37,"----",?45,"---------",?56,"---------",?67,"---------"
- +20 ;
- +21 QUIT
- +22 ;
- NMSPARRY(KMPDNMSP) ;-- namespace arry
- +1 KILL KMPDNMSP
- +2 NEW DIC,NM1,NMSP,PKG,X,Y
- +3 SET DIC=9.4
- SET DIC(0)="AEMQZ"
- SET DIC("A")="Select Namespace: "
- +4 WRITE !
- DO SELECT^KMPDUT4("KMPDNMSP",1,5)
- +5 if $GET(KMPDNMSP(0))=""
- QUIT
- +6 if KMPDNMSP(0)'="*"&($ORDER(KMPDNMSP(0))="")
- QUIT
- +7 IF KMPDNMSP(0)'="*"
- KILL KMPDNMSP(0),NM1
- Begin DoDot:1
- +8 SET I=""
- FOR
- SET I=$ORDER(KMPDNMSP(I))
- if I=""
- QUIT
- SET PKG=KMPDNMSP(I)
- if PKG
- Begin DoDot:2
- +9 SET NMSP=$PIECE($GET(^DIC(9.4,PKG,0)),U,2)
- +10 if NMSP'=""
- SET NM1(NMSP)=PKG
- +11 KILL KMPDNMSP(I)
- End DoDot:2
- +12 MERGE KMPDNMSP=NM1
- End DoDot:1
- +13 ;
- +14 QUIT