- 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 Jan 18, 2025@02:49:03 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