GMRCYP15 ;SLC/JFR-- CONVERT PROCEDURES FROM 101 TO 123.3; 3/08/01 22:00
;;3.0;CONSULT/REQUEST TRACKING;**15**;DEC 27, 1997
;
; This routine invokes IA #3169,#3170
;
EN ;called from post-install of GMRC*3*15
N GMRCPROG,XPDIDTOT
S GMRCPROG=$$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1)
I GMRCPROG=3 D BMES^XPDUTL("Procedure conversion complete") Q
I GMRCPROG<2 D
. D CVTOIS
. D EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,2)
D CVT123
D EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,3)
D MAIL
Q
;
CVTOIS ;loop through ORD ITEMS in S.PROC x-ref
N ITMNM,ORDITM,PROC,PROTID,GMRCID
D EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,1)
D BMES^XPDUTL("Converting Orderable Items")
S ITMNM="",^XTMP("GMRCCVPR",0)=$$FMADD^XLFDT($$NOW^XLFDT,14)
S $P(^XTMP("GMRCCVPR",0),U,2)=$$NOW^XLFDT
S $P(^XTMP("GMRCCVPR",0),U,3)="Conversion of GMRC Procedure ord. items"
F S ITMNM=$O(^ORD(101.43,"S.PROC",ITMNM)) Q:ITMNM="" D
. S ORDITM=0
. F S ORDITM=$O(^ORD(101.43,"S.PROC",ITMNM,ORDITM)) Q:'ORDITM D
.. I '$$OKTOGO(ITMNM,ORDITM) Q
.. S PROC=$$CNVT(ORDITM) I '+PROC Q
.. S PROTID=$P(^ORD(101.43,ORDITM,0),U,2)
.. S GMRCID=$$ID^ORDD43(PROTID,PROC_";99PRC")
.. S ^XTMP("GMRCCVPR",ORDITM)=PROC_U_$S($G(GMRCID):$G(PROTID),1:"ERROR")
.. Q
. Q
Q
OKTOGO(NAME,NUM) ;OK to move from 101.43 to 123.3?
I $D(^XTMP("GMRCCVPR",NUM)) Q 0 ;already converted
I +$G(^ORD(101.43,"S.PROC",NAME,NUM)),$P(^ORD(101.43,NUM,0),U)'=NAME Q 0 ;synonym only
I '+$P(^ORD(101.43,NUM,0),U,2) Q 0 ;no protocol
I $P(^ORD(101.43,NUM,0),U,2)[";99PRC" Q 0 ;new ID already
Q 1
CNVT(IEN) ;move it from 101.43 to 123.3
N DIC,DIE,DR,DA,X,Y,DTOUT,DUOUT,DLAYGO,ORD0,GMRCPROC,NEW
S DIC="^GMR(123.3,",DIC(0)="XL",DLAYGO=123.3
S ORD0=^ORD(101.43,IEN,0)
S X=$$UP^XLFSTR($P(ORD0,U))
D ^DIC I Y'>0 Q 0
S DIE=DIC,DA=+Y,GMRCPROC=+Y,NEW=$P(Y,U,3)
I +NEW S DR=".06_////"_+$P(ORD0,U,2)
I +$G(^ORD(101.43,IEN,.1)) S DR=$S($D(DR):DR_";",1:"")_".02///1"
I $D(DR) D ^DIE
D SYN(IEN,GMRCPROC)
D SERVS(GMRCPROC,+$P(ORD0,U,2))
Q +GMRCPROC
SYN(OITM,PROC) ;get any synonyms from 101.43 and update 123.3
N DR,DIC,X,Y,DTOUT,SYN,DA
S SYN=0
F S SYN=$O(^ORD(101.43,OITM,2,SYN)) Q:'SYN I $L($G(^(SYN,0))) D
. S DA(1)=PROC,DIC="^GMR(123.3,"_DA(1)_",1,"
. S DIC(0)="XL",DIC("P")=$P(^DD(123.3,1,0),U,2)
. S X=$P(^ORD(101.43,OITM,2,SYN,0),U)
. D ^DIC
Q
SERVS(PROC,PROT) ;get related servisces from 123.5 and move to 123.3
N DR,DIC,X,Y,DTOUT,SERV,DA
S SERV=0
F S SERV=$O(^GMR(123.5,"APR",PROT,SERV)) Q:'SERV D
. S DA(1)=PROC,DIC="^GMR(123.3,"_DA(1)_",2,",X=$P(^GMR(123.5,SERV,0),U)
. S DIC(0)="XL",DIC("P")=$P(^DD(123.3,2,0),U,2)
. D ^DIC
Q
CVTPRO(PROT) ;move protocol entry to 123.3
N DIC,DIE,DR,DA,X,Y,DLAYGO,NAME,PROC
I '$D(^ORD(101,PROT,0)) Q 1 ;no protocol there
S NAME=$P(^ORD(101,PROT,0),U,2) I '$L(NAME) Q 1 ;no name
I $G(^ORD(101,PROT,20))'["GMRCEN=""R""" Q "" ;consult type
S DIC="^GMR(123.3,",DIC(0)="LX",X=$$UP^XLFSTR(NAME)
D ^DIC I +Y<0 Q 1
I '$P(Y,U,3) Q +Y
S (PROC,DA)=+Y
S DIE=DIC,DR=".02///1;.06///^S X=PROT" D ^DIE
Q +PROC
;
;
CVT123 ; loop through file 123 and convert field #4 and #13
N IEN,PROC,GMRCCSLT,GMRCPRC,GMR0
D EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,2)
D BMES^XPDUTL("Converting REQUEST/CONSULTATION data")
S XPDIDTOT=$P(^GMR(123,0),U,4) I XPDIDTOT<100 K XPDIDTOT
S GMRCCSLT=$$FIND1^DIC(101,,"QX","GMRCOR CONSULT")
S GMRCPRC=$$FIND1^DIC(101,,"QX","GMRCOR REQUEST")
S IEN=0 F S IEN=$O(^GMR(123,IEN)) Q:'IEN D
. I $D(XPDIDTOT) I '(IEN#(XPDIDTOT\20)) D UPDATE^XPDID(IEN)
. Q:'$D(^GMR(123,IEN,0))
. S GMR0=^GMR(123,IEN,0)
. I $P(GMR0,U,17)'="C"&($P(GMR0,U,17)'="P") D ;not converted yet
.. I $P(GMR0,U,8)["ORD(101" D
... N NWPROC
... S NWPROC=$$CVT4(+$P(^GMR(123,IEN,0),U,8))
... I +NWPROC=1 S ^XTMP("GMRCCVPR","UNK",IEN)=$P(GMR0,U,8)
... S $P(^GMR(123,IEN,0),U,8)=NWPROC
.. S $P(^GMR(123,IEN,0),U,17)=$S(+$P(^GMR(123,IEN,0),U,8):"P",1:"C")
.. Q
. Q
Q
CVT4(PCL) ;convert field 4 from 101 to 123.3
; PCL = pointer to file 101
N PROC
S PROC=$O(^GMR(123.3,"AP",PCL,0))
I 'PROC S PROC=$$CVTPRO(PCL)
Q $S(+PROC:PROC_";GMR(123.3,",1:"")
;
;
MAIL ; check conversion and send mail to installer
D CK10143
D CHK123
I '$D(^TMP("GMRCP15",$J)) D
. S ^TMP("GMRCP15",$J,1,0)="No problems found with the conversion."
S ^TMP("GMRCP15",$J,0)=""
N GMRCSB,GMRCTO,GMRCTXT,GMRCMSG
S GMRCSB="GMRC*3*15 Post-install conversion report"
S GMRCTXT=$NA(^TMP("GMRCP15",$J))
S GMRCTO(DUZ)=""
D SENDMSG^XMXAPI(DUZ,GMRCSB,GMRCTXT,.GMRCTO,,.GMRCMSG)
I $G(GMRCMSG) D
. D BMES^XPDUTL("Mail message "_GMRCMSG_" sent to installer")
. N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,ZTIO,GMRCDUZ
. S GMRCDUZ=DUZ
. S ZTSAVE("GMRCMSG")="",ZTSAVE("GMRCDUZ")=""
. S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,5),ZTRTN="NWMAL^GMRCYP15"
. S ZTIO="",ZTDESC="New GMRC*3*15 post-install message"
. D ^%ZTLOAD
K ^TMP("GMRCP15",$J)
Q
;
NWMAL ;make post-install message new
S ZTREQ="@"
I $G(GMRCMSG),$G(GMRCDUZ) D
. D MAKENEW^XMXUTIL(DUZ,1,GMRCMSG,1)
Q
;
CHK123 ;loop 123 and check field 4 to make sure it's converted
N GMRCIEN,PROC,NEXT
S GMRCIEN=0
I $D(^TMP("GMRCP15",$J)) D
. S ^TMP("GMRCP15",$J,$O(^TMP("GMRCP15",$J," "),-1)+1,0)=""
F S GMRCIEN=$O(^GMR(123,GMRCIEN)) Q:'GMRCIEN D
. I $D(XPDIDTOT) D:'(GMRCIEN#(XPDIDTOT\20)) UPDATE^XPDID(GMRCIEN)
. I '$D(XPDNM) W:'(GMRCIEN#78000) !,"Working",!
. I '$D(XPDNM) W:'(GMRCIEN#1000) "."
. S PROC=$P($G(^GMR(123,GMRCIEN,0)),U,8) I '$L(PROC) Q
. I PROC["ORD(101"!(PROC="1;GMR(123.3,") D
.. S NEXT=$O(^TMP("GMRCP15",$J," "),-1)+1
.. S ^TMP("GMRCP15",$J,NEXT,0)="File 123 ien "_GMRCIEN_" points to "_PROC
. Q
Q
CK10143 ;loop thru S.PROC x-ref in 101.43 and check for complete conv
N OINAME,OINUM,NEXT
D BMES^XPDUTL("Checking converted data")
S OINAME=""
F S OINAME=$O(^ORD(101.43,"S.PROC",OINAME)) Q:OINAME="" D
. S OINUM=$O(^ORD(101.43,"S.PROC",OINAME,0)) Q:'OINUM
. I +$G(^ORD(101.43,"S.PROC",OINAME,OINUM)) Q ;syn only
. I $P($G(^ORD(101.43,OINUM,0)),U,2)'["99PRC" D
.. S NEXT=$O(^TMP("GMRCP15",$J," "),-1)+1
.. S ^TMP("GMRCP15",$J,NEXT,0)="File 101.43 ien "_OINUM_" has a bad ID"
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCYP15 6354 printed Sep 23, 2025@19:23:51 Page 2
GMRCYP15 ;SLC/JFR-- CONVERT PROCEDURES FROM 101 TO 123.3; 3/08/01 22:00
+1 ;;3.0;CONSULT/REQUEST TRACKING;**15**;DEC 27, 1997
+2 ;
+3 ; This routine invokes IA #3169,#3170
+4 ;
EN ;called from post-install of GMRC*3*15
+1 NEW GMRCPROG,XPDIDTOT
+2 SET GMRCPROG=$$GET^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1)
+3 IF GMRCPROG=3
DO BMES^XPDUTL("Procedure conversion complete")
QUIT
+4 IF GMRCPROG<2
Begin DoDot:1
+5 DO CVTOIS
+6 DO EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,2)
End DoDot:1
+7 DO CVT123
+8 DO EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,3)
+9 DO MAIL
+10 QUIT
+11 ;
CVTOIS ;loop through ORD ITEMS in S.PROC x-ref
+1 NEW ITMNM,ORDITM,PROC,PROTID,GMRCID
+2 DO EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,1)
+3 DO BMES^XPDUTL("Converting Orderable Items")
+4 SET ITMNM=""
SET ^XTMP("GMRCCVPR",0)=$$FMADD^XLFDT($$NOW^XLFDT,14)
+5 SET $PIECE(^XTMP("GMRCCVPR",0),U,2)=$$NOW^XLFDT
+6 SET $PIECE(^XTMP("GMRCCVPR",0),U,3)="Conversion of GMRC Procedure ord. items"
+7 FOR
SET ITMNM=$ORDER(^ORD(101.43,"S.PROC",ITMNM))
if ITMNM=""
QUIT
Begin DoDot:1
+8 SET ORDITM=0
+9 FOR
SET ORDITM=$ORDER(^ORD(101.43,"S.PROC",ITMNM,ORDITM))
if 'ORDITM
QUIT
Begin DoDot:2
+10 IF '$$OKTOGO(ITMNM,ORDITM)
QUIT
+11 SET PROC=$$CNVT(ORDITM)
IF '+PROC
QUIT
+12 SET PROTID=$PIECE(^ORD(101.43,ORDITM,0),U,2)
+13 SET GMRCID=$$ID^ORDD43(PROTID,PROC_";99PRC")
+14 SET ^XTMP("GMRCCVPR",ORDITM)=PROC_U_$SELECT($GET(GMRCID):$GET(PROTID),1:"ERROR")
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 QUIT
OKTOGO(NAME,NUM) ;OK to move from 101.43 to 123.3?
+1 ;already converted
IF $DATA(^XTMP("GMRCCVPR",NUM))
QUIT 0
+2 ;synonym only
IF +$GET(^ORD(101.43,"S.PROC",NAME,NUM))
IF $PIECE(^ORD(101.43,NUM,0),U)'=NAME
QUIT 0
+3 ;no protocol
IF '+$PIECE(^ORD(101.43,NUM,0),U,2)
QUIT 0
+4 ;new ID already
IF $PIECE(^ORD(101.43,NUM,0),U,2)[";99PRC"
QUIT 0
+5 QUIT 1
CNVT(IEN) ;move it from 101.43 to 123.3
+1 NEW DIC,DIE,DR,DA,X,Y,DTOUT,DUOUT,DLAYGO,ORD0,GMRCPROC,NEW
+2 SET DIC="^GMR(123.3,"
SET DIC(0)="XL"
SET DLAYGO=123.3
+3 SET ORD0=^ORD(101.43,IEN,0)
+4 SET X=$$UP^XLFSTR($PIECE(ORD0,U))
+5 DO ^DIC
IF Y'>0
QUIT 0
+6 SET DIE=DIC
SET DA=+Y
SET GMRCPROC=+Y
SET NEW=$PIECE(Y,U,3)
+7 IF +NEW
SET DR=".06_////"_+$PIECE(ORD0,U,2)
+8 IF +$GET(^ORD(101.43,IEN,.1))
SET DR=$SELECT($DATA(DR):DR_";",1:"")_".02///1"
+9 IF $DATA(DR)
DO ^DIE
+10 DO SYN(IEN,GMRCPROC)
+11 DO SERVS(GMRCPROC,+$PIECE(ORD0,U,2))
+12 QUIT +GMRCPROC
SYN(OITM,PROC) ;get any synonyms from 101.43 and update 123.3
+1 NEW DR,DIC,X,Y,DTOUT,SYN,DA
+2 SET SYN=0
+3 FOR
SET SYN=$ORDER(^ORD(101.43,OITM,2,SYN))
if 'SYN
QUIT
IF $LENGTH($GET(^(SYN,0)))
Begin DoDot:1
+4 SET DA(1)=PROC
SET DIC="^GMR(123.3,"_DA(1)_",1,"
+5 SET DIC(0)="XL"
SET DIC("P")=$PIECE(^DD(123.3,1,0),U,2)
+6 SET X=$PIECE(^ORD(101.43,OITM,2,SYN,0),U)
+7 DO ^DIC
End DoDot:1
+8 QUIT
SERVS(PROC,PROT) ;get related servisces from 123.5 and move to 123.3
+1 NEW DR,DIC,X,Y,DTOUT,SERV,DA
+2 SET SERV=0
+3 FOR
SET SERV=$ORDER(^GMR(123.5,"APR",PROT,SERV))
if 'SERV
QUIT
Begin DoDot:1
+4 SET DA(1)=PROC
SET DIC="^GMR(123.3,"_DA(1)_",2,"
SET X=$PIECE(^GMR(123.5,SERV,0),U)
+5 SET DIC(0)="XL"
SET DIC("P")=$PIECE(^DD(123.3,2,0),U,2)
+6 DO ^DIC
End DoDot:1
+7 QUIT
CVTPRO(PROT) ;move protocol entry to 123.3
+1 NEW DIC,DIE,DR,DA,X,Y,DLAYGO,NAME,PROC
+2 ;no protocol there
IF '$DATA(^ORD(101,PROT,0))
QUIT 1
+3 ;no name
SET NAME=$PIECE(^ORD(101,PROT,0),U,2)
IF '$LENGTH(NAME)
QUIT 1
+4 ;consult type
IF $GET(^ORD(101,PROT,20))'["GMRCEN=""R"""
QUIT ""
+5 SET DIC="^GMR(123.3,"
SET DIC(0)="LX"
SET X=$$UP^XLFSTR(NAME)
+6 DO ^DIC
IF +Y<0
QUIT 1
+7 IF '$PIECE(Y,U,3)
QUIT +Y
+8 SET (PROC,DA)=+Y
+9 SET DIE=DIC
SET DR=".02///1;.06///^S X=PROT"
DO ^DIE
+10 QUIT +PROC
+11 ;
+12 ;
CVT123 ; loop through file 123 and convert field #4 and #13
+1 NEW IEN,PROC,GMRCCSLT,GMRCPRC,GMR0
+2 DO EN^XPAR("PKG.CONSULT/REQUEST TRACKING","GMRC PROCEDURE CONVERSION",1,2)
+3 DO BMES^XPDUTL("Converting REQUEST/CONSULTATION data")
+4 SET XPDIDTOT=$PIECE(^GMR(123,0),U,4)
IF XPDIDTOT<100
KILL XPDIDTOT
+5 SET GMRCCSLT=$$FIND1^DIC(101,,"QX","GMRCOR CONSULT")
+6 SET GMRCPRC=$$FIND1^DIC(101,,"QX","GMRCOR REQUEST")
+7 SET IEN=0
FOR
SET IEN=$ORDER(^GMR(123,IEN))
if 'IEN
QUIT
Begin DoDot:1
+8 IF $DATA(XPDIDTOT)
IF '(IEN#(XPDIDTOT\20))
DO UPDATE^XPDID(IEN)
+9 if '$DATA(^GMR(123,IEN,0))
QUIT
+10 SET GMR0=^GMR(123,IEN,0)
+11 ;not converted yet
IF $PIECE(GMR0,U,17)'="C"&($PIECE(GMR0,U,17)'="P")
Begin DoDot:2
+12 IF $PIECE(GMR0,U,8)["ORD(101"
Begin DoDot:3
+13 NEW NWPROC
+14 SET NWPROC=$$CVT4(+$PIECE(^GMR(123,IEN,0),U,8))
+15 IF +NWPROC=1
SET ^XTMP("GMRCCVPR","UNK",IEN)=$PIECE(GMR0,U,8)
+16 SET $PIECE(^GMR(123,IEN,0),U,8)=NWPROC
End DoDot:3
+17 SET $PIECE(^GMR(123,IEN,0),U,17)=$SELECT(+$PIECE(^GMR(123,IEN,0),U,8):"P",1:"C")
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
CVT4(PCL) ;convert field 4 from 101 to 123.3
+1 ; PCL = pointer to file 101
+2 NEW PROC
+3 SET PROC=$ORDER(^GMR(123.3,"AP",PCL,0))
+4 IF 'PROC
SET PROC=$$CVTPRO(PCL)
+5 QUIT $SELECT(+PROC:PROC_";GMR(123.3,",1:"")
+6 ;
+7 ;
MAIL ; check conversion and send mail to installer
+1 DO CK10143
+2 DO CHK123
+3 IF '$DATA(^TMP("GMRCP15",$JOB))
Begin DoDot:1
+4 SET ^TMP("GMRCP15",$JOB,1,0)="No problems found with the conversion."
End DoDot:1
+5 SET ^TMP("GMRCP15",$JOB,0)=""
+6 NEW GMRCSB,GMRCTO,GMRCTXT,GMRCMSG
+7 SET GMRCSB="GMRC*3*15 Post-install conversion report"
+8 SET GMRCTXT=$NAME(^TMP("GMRCP15",$JOB))
+9 SET GMRCTO(DUZ)=""
+10 DO SENDMSG^XMXAPI(DUZ,GMRCSB,GMRCTXT,.GMRCTO,,.GMRCMSG)
+11 IF $GET(GMRCMSG)
Begin DoDot:1
+12 DO BMES^XPDUTL("Mail message "_GMRCMSG_" sent to installer")
+13 NEW ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,ZTIO,GMRCDUZ
+14 SET GMRCDUZ=DUZ
+15 SET ZTSAVE("GMRCMSG")=""
SET ZTSAVE("GMRCDUZ")=""
+16 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,5)
SET ZTRTN="NWMAL^GMRCYP15"
+17 SET ZTIO=""
SET ZTDESC="New GMRC*3*15 post-install message"
+18 DO ^%ZTLOAD
End DoDot:1
+19 KILL ^TMP("GMRCP15",$JOB)
+20 QUIT
+21 ;
NWMAL ;make post-install message new
+1 SET ZTREQ="@"
+2 IF $GET(GMRCMSG)
IF $GET(GMRCDUZ)
Begin DoDot:1
+3 DO MAKENEW^XMXUTIL(DUZ,1,GMRCMSG,1)
End DoDot:1
+4 QUIT
+5 ;
CHK123 ;loop 123 and check field 4 to make sure it's converted
+1 NEW GMRCIEN,PROC,NEXT
+2 SET GMRCIEN=0
+3 IF $DATA(^TMP("GMRCP15",$JOB))
Begin DoDot:1
+4 SET ^TMP("GMRCP15",$JOB,$ORDER(^TMP("GMRCP15",$JOB," "),-1)+1,0)=""
End DoDot:1
+5 FOR
SET GMRCIEN=$ORDER(^GMR(123,GMRCIEN))
if 'GMRCIEN
QUIT
Begin DoDot:1
+6 IF $DATA(XPDIDTOT)
if '(GMRCIEN#(XPDIDTOT\20))
DO UPDATE^XPDID(GMRCIEN)
+7 IF '$DATA(XPDNM)
if '(GMRCIEN#78000)
WRITE !,"Working",!
+8 IF '$DATA(XPDNM)
if '(GMRCIEN#1000)
WRITE "."
+9 SET PROC=$PIECE($GET(^GMR(123,GMRCIEN,0)),U,8)
IF '$LENGTH(PROC)
QUIT
+10 IF PROC["ORD(101"!(PROC="1;GMR(123.3,")
Begin DoDot:2
+11 SET NEXT=$ORDER(^TMP("GMRCP15",$JOB," "),-1)+1
+12 SET ^TMP("GMRCP15",$JOB,NEXT,0)="File 123 ien "_GMRCIEN_" points to "_PROC
End DoDot:2
+13 QUIT
End DoDot:1
+14 QUIT
CK10143 ;loop thru S.PROC x-ref in 101.43 and check for complete conv
+1 NEW OINAME,OINUM,NEXT
+2 DO BMES^XPDUTL("Checking converted data")
+3 SET OINAME=""
+4 FOR
SET OINAME=$ORDER(^ORD(101.43,"S.PROC",OINAME))
if OINAME=""
QUIT
Begin DoDot:1
+5 SET OINUM=$ORDER(^ORD(101.43,"S.PROC",OINAME,0))
if 'OINUM
QUIT
+6 ;syn only
IF +$GET(^ORD(101.43,"S.PROC",OINAME,OINUM))
QUIT
+7 IF $PIECE($GET(^ORD(101.43,OINUM,0)),U,2)'["99PRC"
Begin DoDot:2
+8 SET NEXT=$ORDER(^TMP("GMRCP15",$JOB," "),-1)+1
+9 SET ^TMP("GMRCP15",$JOB,NEXT,0)="File 101.43 ien "_OINUM_" has a bad ID"
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
