MDCONUTL ; WOIFO/KLM - CP Conversion Utility ;31 Oct 2018 2:31 PM
;;1.0;CLINICAL PROCEDURES;**65,89**;May 07, 2024;Build 2
; This utility is based on Shirley Ackerman's ZZNACVT and ZZNACVT1
; class III conversion routines.
;
; Integration Control Registration (ICR's):
; Reference to File 100.01 in ICR #2638
; Reference to File 123 in ICR #3067
; Reference to ^GMR(123,"AE" in ICR #5062
; Reference to File 123.3 in ICR #6926
; Reference to File 123.5 in ICR #6927
; Reference to ^MAG(2006.5831 in ICR #6959
;
; MD*89/RJH - For the MD PROCONVERT option, divert the logic to the new
; MDCONUT2 routine where another prompt for REQUEST SERVICE has
; been added. New routine and logic implemented in order not to
; adversely affect the MD CONCONVERT option. MDOPT("PROCONVERT")
; array is set upon entry to the MD PROCONVERT option and should
; be available to check in the CONVERT tag below. Also updated
; the ICR notes above to meet new SAC standard.
;
CONVERT ; Convert consults to procedures.
;;MDOPT defined from the entry action of the option used.
Q:'$D(MDOPT)#2
I $D(MDOPT("PROCONVERT")) D EN^MDCONUT2 Q ; *89
N MDCOUNT,MDCP,MDCPR,MDCPRST,MDCPST,MDFDA,MDFILE,MDL,MDLP,MDSERV,MDIEN,MDTE,MDTOS,MDFR
N MDFRE,MDTOSE,MDCPRE,MDX
S MDFILE=123
S MDCOUNT=0
I $D(MDOPT("CONCONVERT"))#2 D
.D CSCVRT
.Q
E D
.D PRCVRT
.Q
I '$G(MDX) D START
Q
CSCVRT ;Select consult service and procedure for conversion
W !!,"This routine utility will get all the pending consults of "
W !,"a selected REQUEST SERVICE and convert them to a selected GMRC procedures.",!
W !,"Note that consults that are currently setup with DICOM (in the CLINICAL "
W !,"SPECIALTY DICOM & HL7 file) cannot be converted to CP with this utility."
W !,"DICOM consults will need to discontinued and re-ordered.",!
D SETTS I '$G(MDTOS) S MDX=1 Q
S MDF=1 D SETPR(MDF) I '$G(MDCPR) S MDX=1 Q
K MDF
Q
PRCVRT ;Select consult service and procedures for conversion
W !!,"This routine utility will get all the pending, active, and"
W !,"scheduled procedures of a selected REQUEST SERVICE and convert"
W !,"them to a selected GMRC procedures.",!
W !,"Note that Procedures that are currently setup with DICOM (in the CLINICAL "
W !,"SPECIALTY DICOM & HL7 file) cannot be converted to CP with this utility."
W !,"DICOM procedures will need to discontinued and re-ordered.",!
S MDF=0 D SETPR(MDF) I '$G(MDTOS)!('$G(MDFR)) S MDX=1 Q
S MDF=1 D SETPR(MDF) I '$G(MDCPR) S MDX=1 Q
K MDF
Q
START ; Start process conversion
S MDCP=$$GET1^DIQ(123.3,+MDCPR_",",.04,"I")
I 'MDCP D
.W !,"Missing Clinical Procedure Definition in ",$$GET1^DIQ(123.3,+MDCPR,.01),!
.S DIC="^MDS(702.01,",DIC(0)="AEMNQ"
.D ^DIC Q:Y<1!($D(DTOUT))!($D(DUOUT))
.S MDCP=+Y
.S MDFDA(123.3,MDCPR_",",.04)=+MDCP
.L +^GMR(123.3,MDCPR):1 I '$T Q
.D FILE^DIE("","MDFDA") K MDFDA
.L -^GMR(123.3,MDCPR)
.Q
I 'MDCP W !,"Still missing CP Definition." Q
I $D(MDOPT("CONCONVERT"))#2 D
.W !!,"We will proceed to convert ",MDTOSE," consults to"
.Q
E D
.W !!,"We will proceed to convert ",MDFRE," in ",MDTOSE," to "
.Q
W !,MDCPRE," procedures...",!
W ! S MDSERV=$$GETSER(+MDCPR) I 'MDSERV W !,"RELATED SERVICE missing from "_$S($D(MDCPRE):MDCPRE,1:MDFRE)_" - no records converted" Q
S MDL="" F S MDL=$O(^GMR(MDFILE,"AE",MDTOS,MDL)) Q:MDL<1 D
.S MDCPST=MDL
.S MDCPRST=$$GET1^DIQ(100.01,MDCPST_",",.01,"E")
.I MDCPRST'="PENDING"&(MDCPRST'="ACTIVE")&(MDCPRST'="SCHEDULED") Q
.S MDTE=0 F S MDTE=$O(^GMR(MDFILE,"AE",MDTOS,MDL,MDTE)) Q:MDTE<1 D
..S MDLP=0 F S MDLP=$O(^GMR(MDFILE,"AE",MDTOS,MDL,MDTE,MDLP)) Q:MDLP<1 D
...I $D(MDOPT("CONCONVERT"))#2,$$GET1^DIQ(MDFILE,MDLP_",",13,"I")="P" Q
...I $D(MDOPT("PROCONVERT"))#2 D Q:(MDX'["GMR(123.3")!(+MDX'=+MDFR)
....S MDX=$$GET1^DIQ(MDFILE,MDLP_",",4,"I")
....Q
...S MDIEN=MDLP
...S MDFDA(123,MDIEN_",",1)=+MDSERV
...S MDFDA(123,MDIEN_",",1.01)=+MDCP
...S MDFDA(123,MDIEN_",",4)=+MDCPR_";"_"GMR(123.3,"
...S MDFDA(123,MDIEN_",",13)="P"
...L +^GMR(123,MDIEN):1 I '$T Q
...D FILE^DIE("","MDFDA")
...L -^GMR(123,MDIEN)
...S MDCOUNT=MDCOUNT+1 W !," Record # ",MDIEN," converted." Q
..Q
.Q
W !!,"Total Records converted = ",MDCOUNT
Q
GETSER(MDNUM) ; Get the Consult service
N MDK,MDIENS,MDARY,MDY
S MDIENS=MDNUM_","
D GETS^DIQ(123.3,MDIENS,"2*","I","MDARY")
S MDK=0 F S MDK=$O(MDARY(123.32,MDK)) Q:'MDK S MDY=$G(MDARY(123.32,MDK,.01,"I"))
Q:$D(MDY) MDY
Q 0
SETTS ;Set Consult 'TO SERVICE'
N DIC,X,Y,DTOUT,DUOUT
S DIC="^GMR(123.5,",DIC(0)="AEMNQ"
;No DICOM consults allowed
S:$D(MDOPT("CONCONVERT"))#2 DIC("S")="I $$DICSRN^MDCONUTL(+Y)"
D ^DIC I Y<1!($D(DTOUT))!($D(DUOUT)) Q
S MDTOS=+Y,MDTOSE=$P(Y,U,2)
Q
SETPR(MDF) ;Set Procedure
;MDF=0 : Convert FROM, MDF=1 : Convert TO
N DIC,X,Y,DTOUT,DUOUT,MDQ
;Convert FROM selection to include the related service of selected procedure. No DICOM procedures allowed.
F Q:'$D(MDF) D
.S DIC="^GMR(123.3,",DIC(0)="AEMNQ",DIC("A")="Select a GMRC Procedure to convert "_$S(MDF>0:"TO: ",1:"FROM: ")
.D ^DIC I Y<1!($D(DTOUT))!($D(DUOUT)) K MDF Q
.I MDF=0,$$GET1^DIQ(123.3,+Y,.04)]"" W !!,"This procedure is already a CP - cannot convert",! Q
.I MDF S MDCPR=+Y,MDCPRE=$P(Y,U,2) K MDF
.E S MDFR=+Y,MDFRE=$P(Y,U,2) K MDF
.Q
I '$D(MDFR)!($D(MDTOS)) Q
;Related Service[123.32P]
N DIC,X,Y,DTOUT,DUOUT
;Only allow service related to selected procedure
S DIC="^GMR(123.5,",DIC(0)="AEMNQ",DIC("S")="I ($D(^GMR(123.3,MDFR,2,""B"",+Y)))"
D ^DIC I Y<1!($D(DTOUT))!($D(DUOUT)) Q
I $D(^MAG(2006.5831,"C",+Y,MDFR)) W !!,"Procedure/Service setup for DICOM - Cannot convert" Q
S MDTOS=+Y,MDTOSE=$P(Y,U,2)
Q
DICSRN(MDCON) ;Screen for DICOM consults
;Check each entry for a procedure. If no procedure, it's setup as a consult
;and will be screened. Procedure/consult combo is a separate screen on the
;procedure conversion option.
N MDDA,MDS S MDS=1
S MDDA="" F S MDDA=$O(^MAG(2006.5831,"B",MDCON,MDDA)) Q:MDDA="" D Q:'MDS
.S:$$GET1^DIQ(2006.5831,MDDA,2)="" MDS=0
.Q
Q MDS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDCONUTL 6202 printed Dec 13, 2024@01:42:26 Page 2
MDCONUTL ; WOIFO/KLM - CP Conversion Utility ;31 Oct 2018 2:31 PM
+1 ;;1.0;CLINICAL PROCEDURES;**65,89**;May 07, 2024;Build 2
+2 ; This utility is based on Shirley Ackerman's ZZNACVT and ZZNACVT1
+3 ; class III conversion routines.
+4 ;
+5 ; Integration Control Registration (ICR's):
+6 ; Reference to File 100.01 in ICR #2638
+7 ; Reference to File 123 in ICR #3067
+8 ; Reference to ^GMR(123,"AE" in ICR #5062
+9 ; Reference to File 123.3 in ICR #6926
+10 ; Reference to File 123.5 in ICR #6927
+11 ; Reference to ^MAG(2006.5831 in ICR #6959
+12 ;
+13 ; MD*89/RJH - For the MD PROCONVERT option, divert the logic to the new
+14 ; MDCONUT2 routine where another prompt for REQUEST SERVICE has
+15 ; been added. New routine and logic implemented in order not to
+16 ; adversely affect the MD CONCONVERT option. MDOPT("PROCONVERT")
+17 ; array is set upon entry to the MD PROCONVERT option and should
+18 ; be available to check in the CONVERT tag below. Also updated
+19 ; the ICR notes above to meet new SAC standard.
+20 ;
CONVERT ; Convert consults to procedures.
+1 ;;MDOPT defined from the entry action of the option used.
+2 if '$DATA(MDOPT)#2
QUIT
+3 ; *89
IF $DATA(MDOPT("PROCONVERT"))
DO EN^MDCONUT2
QUIT
+4 NEW MDCOUNT,MDCP,MDCPR,MDCPRST,MDCPST,MDFDA,MDFILE,MDL,MDLP,MDSERV,MDIEN,MDTE,MDTOS,MDFR
+5 NEW MDFRE,MDTOSE,MDCPRE,MDX
+6 SET MDFILE=123
+7 SET MDCOUNT=0
+8 IF $DATA(MDOPT("CONCONVERT"))#2
Begin DoDot:1
+9 DO CSCVRT
+10 QUIT
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 DO PRCVRT
+13 QUIT
End DoDot:1
+14 IF '$GET(MDX)
DO START
+15 QUIT
CSCVRT ;Select consult service and procedure for conversion
+1 WRITE !!,"This routine utility will get all the pending consults of "
+2 WRITE !,"a selected REQUEST SERVICE and convert them to a selected GMRC procedures.",!
+3 WRITE !,"Note that consults that are currently setup with DICOM (in the CLINICAL "
+4 WRITE !,"SPECIALTY DICOM & HL7 file) cannot be converted to CP with this utility."
+5 WRITE !,"DICOM consults will need to discontinued and re-ordered.",!
+6 DO SETTS
IF '$GET(MDTOS)
SET MDX=1
QUIT
+7 SET MDF=1
DO SETPR(MDF)
IF '$GET(MDCPR)
SET MDX=1
QUIT
+8 KILL MDF
+9 QUIT
PRCVRT ;Select consult service and procedures for conversion
+1 WRITE !!,"This routine utility will get all the pending, active, and"
+2 WRITE !,"scheduled procedures of a selected REQUEST SERVICE and convert"
+3 WRITE !,"them to a selected GMRC procedures.",!
+4 WRITE !,"Note that Procedures that are currently setup with DICOM (in the CLINICAL "
+5 WRITE !,"SPECIALTY DICOM & HL7 file) cannot be converted to CP with this utility."
+6 WRITE !,"DICOM procedures will need to discontinued and re-ordered.",!
+7 SET MDF=0
DO SETPR(MDF)
IF '$GET(MDTOS)!('$GET(MDFR))
SET MDX=1
QUIT
+8 SET MDF=1
DO SETPR(MDF)
IF '$GET(MDCPR)
SET MDX=1
QUIT
+9 KILL MDF
+10 QUIT
START ; Start process conversion
+1 SET MDCP=$$GET1^DIQ(123.3,+MDCPR_",",.04,"I")
+2 IF 'MDCP
Begin DoDot:1
+3 WRITE !,"Missing Clinical Procedure Definition in ",$$GET1^DIQ(123.3,+MDCPR,.01),!
+4 SET DIC="^MDS(702.01,"
SET DIC(0)="AEMNQ"
+5 DO ^DIC
if Y<1!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+6 SET MDCP=+Y
+7 SET MDFDA(123.3,MDCPR_",",.04)=+MDCP
+8 LOCK +^GMR(123.3,MDCPR):1
IF '$TEST
QUIT
+9 DO FILE^DIE("","MDFDA")
KILL MDFDA
+10 LOCK -^GMR(123.3,MDCPR)
+11 QUIT
End DoDot:1
+12 IF 'MDCP
WRITE !,"Still missing CP Definition."
QUIT
+13 IF $DATA(MDOPT("CONCONVERT"))#2
Begin DoDot:1
+14 WRITE !!,"We will proceed to convert ",MDTOSE," consults to"
+15 QUIT
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 WRITE !!,"We will proceed to convert ",MDFRE," in ",MDTOSE," to "
+18 QUIT
End DoDot:1
+19 WRITE !,MDCPRE," procedures...",!
+20 WRITE !
SET MDSERV=$$GETSER(+MDCPR)
IF 'MDSERV
WRITE !,"RELATED SERVICE missing from "_$SELECT($DATA(MDCPRE):MDCPRE,1:MDFRE)_" - no records converted"
QUIT
+21 SET MDL=""
FOR
SET MDL=$ORDER(^GMR(MDFILE,"AE",MDTOS,MDL))
if MDL<1
QUIT
Begin DoDot:1
+22 SET MDCPST=MDL
+23 SET MDCPRST=$$GET1^DIQ(100.01,MDCPST_",",.01,"E")
+24 IF MDCPRST'="PENDING"&(MDCPRST'="ACTIVE")&(MDCPRST'="SCHEDULED")
QUIT
+25 SET MDTE=0
FOR
SET MDTE=$ORDER(^GMR(MDFILE,"AE",MDTOS,MDL,MDTE))
if MDTE<1
QUIT
Begin DoDot:2
+26 SET MDLP=0
FOR
SET MDLP=$ORDER(^GMR(MDFILE,"AE",MDTOS,MDL,MDTE,MDLP))
if MDLP<1
QUIT
Begin DoDot:3
+27 IF $DATA(MDOPT("CONCONVERT"))#2
IF $$GET1^DIQ(MDFILE,MDLP_",",13,"I")="P"
QUIT
+28 IF $DATA(MDOPT("PROCONVERT"))#2
Begin DoDot:4
+29 SET MDX=$$GET1^DIQ(MDFILE,MDLP_",",4,"I")
+30 QUIT
End DoDot:4
if (MDX'["GMR(123.3")!(+MDX'=+MDFR)
QUIT
+31 SET MDIEN=MDLP
+32 SET MDFDA(123,MDIEN_",",1)=+MDSERV
+33 SET MDFDA(123,MDIEN_",",1.01)=+MDCP
+34 SET MDFDA(123,MDIEN_",",4)=+MDCPR_";"_"GMR(123.3,"
+35 SET MDFDA(123,MDIEN_",",13)="P"
+36 LOCK +^GMR(123,MDIEN):1
IF '$TEST
QUIT
+37 DO FILE^DIE("","MDFDA")
+38 LOCK -^GMR(123,MDIEN)
+39 SET MDCOUNT=MDCOUNT+1
WRITE !," Record # ",MDIEN," converted."
QUIT
End DoDot:3
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
+42 WRITE !!,"Total Records converted = ",MDCOUNT
+43 QUIT
GETSER(MDNUM) ; Get the Consult service
+1 NEW MDK,MDIENS,MDARY,MDY
+2 SET MDIENS=MDNUM_","
+3 DO GETS^DIQ(123.3,MDIENS,"2*","I","MDARY")
+4 SET MDK=0
FOR
SET MDK=$ORDER(MDARY(123.32,MDK))
if 'MDK
QUIT
SET MDY=$GET(MDARY(123.32,MDK,.01,"I"))
+5 if $DATA(MDY)
QUIT MDY
+6 QUIT 0
SETTS ;Set Consult 'TO SERVICE'
+1 NEW DIC,X,Y,DTOUT,DUOUT
+2 SET DIC="^GMR(123.5,"
SET DIC(0)="AEMNQ"
+3 ;No DICOM consults allowed
+4 if $DATA(MDOPT("CONCONVERT"))#2
SET DIC("S")="I $$DICSRN^MDCONUTL(+Y)"
+5 DO ^DIC
IF Y<1!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+6 SET MDTOS=+Y
SET MDTOSE=$PIECE(Y,U,2)
+7 QUIT
SETPR(MDF) ;Set Procedure
+1 ;MDF=0 : Convert FROM, MDF=1 : Convert TO
+2 NEW DIC,X,Y,DTOUT,DUOUT,MDQ
+3 ;Convert FROM selection to include the related service of selected procedure. No DICOM procedures allowed.
+4 FOR
if '$DATA(MDF)
QUIT
Begin DoDot:1
+5 SET DIC="^GMR(123.3,"
SET DIC(0)="AEMNQ"
SET DIC("A")="Select a GMRC Procedure to convert "_$SELECT(MDF>0:"TO: ",1:"FROM: ")
+6 DO ^DIC
IF Y<1!($DATA(DTOUT))!($DATA(DUOUT))
KILL MDF
QUIT
+7 IF MDF=0
IF $$GET1^DIQ(123.3,+Y,.04)]""
WRITE !!,"This procedure is already a CP - cannot convert",!
QUIT
+8 IF MDF
SET MDCPR=+Y
SET MDCPRE=$PIECE(Y,U,2)
KILL MDF
+9 IF '$TEST
SET MDFR=+Y
SET MDFRE=$PIECE(Y,U,2)
KILL MDF
+10 QUIT
End DoDot:1
+11 IF '$DATA(MDFR)!($DATA(MDTOS))
QUIT
+12 ;Related Service[123.32P]
+13 NEW DIC,X,Y,DTOUT,DUOUT
+14 ;Only allow service related to selected procedure
+15 SET DIC="^GMR(123.5,"
SET DIC(0)="AEMNQ"
SET DIC("S")="I ($D(^GMR(123.3,MDFR,2,""B"",+Y)))"
+16 DO ^DIC
IF Y<1!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+17 IF $DATA(^MAG(2006.5831,"C",+Y,MDFR))
WRITE !!,"Procedure/Service setup for DICOM - Cannot convert"
QUIT
+18 SET MDTOS=+Y
SET MDTOSE=$PIECE(Y,U,2)
+19 QUIT
DICSRN(MDCON) ;Screen for DICOM consults
+1 ;Check each entry for a procedure. If no procedure, it's setup as a consult
+2 ;and will be screened. Procedure/consult combo is a separate screen on the
+3 ;procedure conversion option.
+4 NEW MDDA,MDS
SET MDS=1
+5 SET MDDA=""
FOR
SET MDDA=$ORDER(^MAG(2006.5831,"B",MDCON,MDDA))
if MDDA=""
QUIT
Begin DoDot:1
+6 if $$GET1^DIQ(2006.5831,MDDA,2)=""
SET MDS=0
+7 QUIT
End DoDot:1
if 'MDS
QUIT
+8 QUIT MDS
