MDCVT ; HOIFO/DP/NCA - Medicine Package Conversion ;10/20/04 12:49
;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
; Integration Agreements:
; IA# 2263 [Supported] XPAR parameter calls.
; IA# 2320 [Supported] %ZISH calls.
; IA#10031 [Supported] DDS call to bring up Screen Man
;
EN ; [Procedure] Main entry point to convert database to TIU notes
N MDCNVT,MDDIR,MDFILE,MDREC,MDTEST,MDTIUI,MDXR,ORHFS,X,Y
S (MDCNVT("CR"),MDCNVT("CT"),MDCNVT("E"),MDCNVT("S"),MDCNVT("TOT"))=0
I $$GET^XPAR("SYS","MD MEDICINE CONVERTED",1) W !!,"Already Converted" Q
I '$P($G(^MDD(703.9,1,0)),U,3) W !!,"No Administrative Closure Person." Q
S MDTEST=+$P($G(^MDD(703.9,1,0)),U,2)'=1
S MDXR=$O(^MDD(703.9,1,2,"AS","")) I MDXR="" W !!,"No Conversion List. Run Build Conversion List option." Q
;
W @IOF,!,"Medicine to Clinical Procedure Conversion"
K DIR S DIR(0)="YA"
S DIR("A")="Ok to continue? "
S DIR("A",1)="Running conversion in "_$S(MDTEST:"TEST",1:"REAL")_" mode.",DIR("B")="NO" D ^DIR K DIR Q:$D(DIRUT)!$D(DIROUT)!(Y<1)
;
; Set up the HFS variables
S MDFILE="MDCVT.TXT",MDDIR=$P($G(^MDD(703.9,1,.1)),U)
S X=$$TESTHFS() I '+X W !!,"HFS Device Error: ",$P(X,U,2) Q
;
; Last Chance
W ! K DIR S DIR(0)="YA"
S DIR("A")="Ready to "_$S(MDTEST:"test the conversion of",1:"convert")_" the Medicine Files? "
S DIR("B")="NO" D ^DIR K DIR Q:$D(DIRUT)!$D(DIROUT)!(Y<1)
;
; See if previous errors need to be reset
W !!,"Conversion in progress...",!
D RESET
;
; Set MDREC up here - This prevents loss on M error trap in EN1
S MDREC=0
;
W !?5,"[.] Indicates converted record"
W !?5,"[*] Indicates error in record",!!
;
EN1 ; [Procedure] Resumes on error via $ETRAP variable
N $ESTACK,$ETRAP S $ETRAP="ERR^MDCVT"
N MDCONS,MDECON,MDFDA,MDNODE,MDNOTE,MDOK,MDPR,MDR,MDR1,MDSTUD,MDUSR,MDX1
F S MDREC=$O(^MDD(703.9,1,2,"AS","R",MDREC)) Q:'MDREC D
.S MDPTR=$$GET1^DIQ(703.92,MDREC_",1,",.01) Q:MDPTR=""
.S MDGBL=U_$P(MDPTR,";",2)_$P(MDPTR,";",1)_")"
.S MDCNVT("TOT")=MDCNVT("TOT")+1
.I '$P($G(^MDD(703.9,1,1,+$P(MDGBL,"(",2),0)),U,3) D Q
..D SKIP(MDPTR,"Report type not marked for conversion")
..S MDCNVT("S")=MDCNVT("S")+1
.S MDSTAT=$P($G(@MDGBL@("ES")),U,7)
.I MDSTAT="" D Q:'MDOK
..S MDOK=+$P($G(^MDD(703.9,1,1,+$P(MDGBL,"(",2),0)),U,4)
..D:'MDOK LOGERR(MDPTR,"Unable to determine status")
.I MDSTAT="S" D SKIP(MDPTR,"Report Superseded") S MDCNVT("S")=MDCNVT("S")+1 Q
.I MDSTAT["D" D LOGERR(MDPTR,"Report in Draft/Problem Draft status") Q
.;I MDSTAT="RNV" D LOGERR(MDPTR,"Report not verified") Q
.I MDTEST W "." ; Progress indicator
.;
.; Produce report using HFS device MDHFS
.S %ZIS("HFSNAME")=MDDIR_MDFILE,%ZIS("HFSMODE")="W",IOP="MDHFS;P-MDHFS"
.D ^%ZIS I POP D LOGERR(MDPTR,"No HFS Access or device MDHFS") Q
.S ORHFS="SCRATCH"
.U IO D EN^MCAPI(MDPTR,0) D ^%ZISC
.;
.; Fetch the report text
.K ^TMP($J)
.S X=$$FTG^%ZISH(MDDIR,MDFILE,$NA(^TMP($J,1)),2)
.;
.; Delete the Host File
.S DELETE(MDFILE)=""
.S X=$$DEL^%ZISH(MDDIR,"DELETE")
.; Is it a valid report?
.S LINES=$O(^TMP($J,""),-1)
.S BYTES=0 F X=0:0 S X=$O(^TMP($J,X)) Q:'X S BYTES=BYTES+$L(^(X))
.I LINES<5&(^TMP($J,2)["BAD MEDICINE") D LOGERR(MDPTR,^TMP($J,2)) Q
.;
.; Get Legal header For Report
.S RESULTS=$NA(^TMP($J)) D GETHDR^MDESPRT(.RESULTS,MDPTR)
.;
.; If test mode quit at this point
.I MDTEST D FINISH(MDPTR,LINES,BYTES,"") S MDCNVT("CT")=MDCNVT("CT")+1 Q
.;
.; If real mode set to Unspecified Error status and proceed
.;D LOGERR(MDPTR,"Unspecified Error")
.S MDNODE=$G(^MDD(703.9,1,2,+MDREC,0))
.S MDNODE=$P(MDNODE,U,1)
.;
.; Create the note
.S MDTIUI=$$CONVERT^MDCVT1(MDNODE,$NA(^TMP($J)))
.I +MDTIUI'>0 D LOGERR(MDPTR,"Couldn't create the TIU document") Q
.;
.; Update Consults and Imaging
.;
.D UPD^MDCVT1(MDGBL,MDNODE,MDTIUI,MDTEST)
.;
.; Flag as finished
.;
.D FINISH(MDPTR,LINES,BYTES,MDTIUI) S MDCNVT("CR")=MDCNVT("CR")+1
;
D TOTALS^MDCVT1(.MDCNVT)
Q
;
TESTHFS() ; Verify HFS is working properly
N MDNOW
S %ZIS("HFSNAME")=MDDIR_MDFILE,%ZIS("HFSMODE")="W",IOP="MDHFS;P-MDHFS"
D ^%ZIS I POP W !,"No HFS Access or missing device MDHFS" Q 0
S X=1 D Q:'X 0
.I IOT'="HFS" W !,"Device MDHFS not of type HFS" S X=0
.I IOST'="P-MDHFS" W !,"Missing Terminal Type P-MDHFS" S X=0 Q
.I IOSL'=88 W !,"Improper Page Length in Terminal Type P-MDHFS" S X=0
.I IOM'=80 W !,"Improper Page Width in Terminal Type P-MDHFS" S X=0
.I IOF'="#" W !,"Improper Form Feed in Terminal Type P-MDHFS" S X=0
;
D NOW^%DTC S MDNOW=% K %
U IO W !!,MDNOW
D ^%ZISC
;
; Fetch the text
K ^TMP($J)
S X=$$FTG^%ZISH(MDDIR,MDFILE,$NA(^TMP($J,1)),2)
I 'X W !,"Unable to retrieve data back from Host File" Q 0
I ^TMP($J,3)'=MDNOW W !,"Error verifying data in Host File" Q 0
;
; Delete the Host File
S DELETE(MDFILE)=""
S X=$$DEL^%ZISH(MDDIR,"DELETE")
I X'=1 W !,"Unable delete Host File" Q 0
Q 1
;
ERR ; M Error trap submodule to document error and continue
D LOGERR(MDPTR,$ECODE)
I $G(ION)="MDHFS" D ^%ZISC ; Close device if using the HFS
G EN1
;
FINISH(MDPTR,LINES,BYTES,TIUIEN) ; Update status to converted
N MDFDA,MDIEN,MDIENS
S MDIEN=$O(^MDD(703.9,1,2,"B",MDPTR,0))
I MDIEN<1 W !,"Error, no log entry ",MDPTR Q
S MDIENS=MDIEN_",1,"
I MDTEST S MDFDA(703.92,MDIENS,.02)="CT"
E S MDFDA(703.92,MDIENS,.02)="CR"
S MDFDA(703.92,MDIENS,.03)=TIUIEN
S MDFDA(703.92,MDIENS,.04)=LINES
S MDFDA(703.92,MDIENS,.05)=BYTES
S MDFDA(703.92,MDIENS,.1)=LINES_" lines, "_BYTES_" bytes"
D FILE^DIE("","MDFDA")
Q
;
LOGERR(MDPTR,ERRMSG) ; Log conversion error
N MDFDA,MDIEN,MDIENS
S MDIEN=$O(^MDD(703.9,1,2,"B",MDPTR,0))
I MDIEN<1 W !,"Error, no log entry ",MDPTR Q
S MDIENS=MDIEN_",1,"
S MDFDA(703.92,MDIENS,.02)="E"
S MDFDA(703.92,MDIENS,.1)=$TR(ERRMSG,U,"~")
D FILE^DIE("","MDFDA")
W "*" ; Progress indicator
Q
;
RESET ; Reset error status reports to READY TO CONVERT
N MDIEN S MDIEN=0
; Check for real mode and convert test conversions
I 'MDTEST F S MDIEN=$O(^MDD(703.9,1,2,"AS","CT",MDIEN)) Q:'MDIEN D
.N MDFDA
.S MDFDA(703.92,MDIEN_",1,",.02)="R"
.D FILE^DIE("","MDFDA")
; Regardless of mode switch skipped back to ready
F S MDIEN=$O(^MDD(703.9,1,2,"AS","S",MDIEN)) Q:'MDIEN D
.N MDFDA
.S MDFDA(703.92,MDIEN_",1,",.02)="R"
.D FILE^DIE("","MDFDA")
; Regardless of mode switch errors back to ready
F S MDIEN=$O(^MDD(703.9,1,2,"AS","E",MDIEN)) Q:'MDIEN D
.N MDFDA
.S MDFDA(703.92,MDIEN_",1,",.02)="R"
.D FILE^DIE("","MDFDA")
Q
;
REBUILD ; [Procedure] Build the file manually
N MDROOT
S X=$P(^MDD(703.9,0),U,1,2)_U_U K ^MDD(703.9) S ^MDD(703.9,0)=X
S MDROOT=$NA(^MDD(703.9,1))
S @MDROOT@(0)="DEFAULT"
S @MDROOT@(1,0)="^703.91P^^"
F X=691,691.1,691.5,691.6,691.7,691.8,694,694.5,698,698.1,698.2,698.3,699,699.5,700,701 S @MDROOT@(1,X,0)=X
S DA=1,DIK="^MDD(703.9," D IXALL^DIK K DA,DIK
Q
;
SETUP ; [Procedure]
I '$O(^MDD(703.9,0)) W !,"Initializing..." D REBUILD,SETDEF^MDSTATU
S DDSFILE=703.9,DR="[MD MAIN]",DA=1 D ^DDS
Q
;
SKIP(MDPTR,REASON) ; [Procedure] Skip Report
N MDFDA,MDIEN,MDIENS
S MDIEN=$O(^MDD(703.9,1,2,"B",MDPTR,0))
I MDIEN<1 W !,"Error, no log entry ",MDPTR Q
S MDIENS=MDIEN_",1,"
S MDFDA(703.92,MDIENS,.02)="S"
S MDFDA(703.92,MDIENS,.1)=$TR(REASON,U,"~")
D FILE^DIE("","MDFDA")
Q
;
SYNC(MDPTR) ; Make sure entry exists
N MDFDA
Q:$O(^MDD(703.9,1,2,"B",MDPTR,0))
Q:$O(^MDD(702,"ACONV",MDPTR,0))
S MDFDA(703.92,"+1,1,",.01)=MDPTR
S MDFDA(703.92,"+1,1,",.02)="R"
D UPDATE^DIE("","MDFDA")
Q
;
LOCKOUT ; Lockout Options and set API Flag
D ^MDOUTOR
Q
;
STATUS(MDPTR) ; [Procedure] Return status of VPtr
S X=$O(^MDD(703.9,1,2,"B",MDPTR,0))
I X Q $P($G(^MDD(703.9,1,2,X,0)),U,2) ; Return actual status
N MDFDA,MDIEN,MDMSG
S MDFDA(703.92,"+1,1,",.01)=MDPTR
S MDFDA(703.92,"+1,1,",.02)="N"
D UPDATE^DIE("","MDFDA","MDIEN","MDMSG")
I $G(MDIEN(1))<1 W !,"Error adding to conversion log ",MDPTR Q -1
Q "N"
;
SUMMARY ; Disk space requirements
N FILE,LP,TOTB,TOTC,TOTL,X
W !!,"Summarizing..."
K ^TMP($J)
S (TOTL,TOTC,TOTB)=0
S MDSTAT=$O(^MDD(703.9,1,2,"AS","C")) ; will be CT or CR
I MDSTAT'["C" W !!,"No report was converted. You MUST run the conversion in TEST or",!,"REAL mode first to be able to display the Disk Space Requirements." Q
D S1 I MDSTAT="CR" S MDSTAT="CT" D S1
W @IOF,!,"FILE",?42,$J("COUNT",8),?52,$J("LINES",8),?62,$J("BYTES",12)
W !,$TR($J("",79)," ","-")
S X="" F S X=$O(^TMP($J,X)) Q:X="" D
.W !,$E($P(@X,U,1),1,40)
.W ?42,$J(^TMP($J,X,"C"),8)
.W ?52,$J(^TMP($J,X,"L"),8)
.W ?62,$J(^TMP($J,X,"B"),12)
.S TOTC=TOTC+^TMP($J,X,"C")
.S TOTL=TOTL+^TMP($J,X,"L")
.S TOTB=TOTB+^TMP($J,X,"B")
W !?42,$TR($J("",37)," ","=")
W !?42,$J(TOTC,8),?52,$J(TOTL,8),?62,$J(TOTB,12) K ^TMP($J)
Q
;
S1 ; Loop for both CT or CR Statuses
N X S X="" F S X=$O(^MDD(703.9,1,2,"AS",MDSTAT,X)) Q:X="" D
.S FILE=$P($G(^MDD(703.9,1,2,X,0)),U,1)
.S FILE=U_$P(FILE,";",2)_"0)"
.S ^TMP($J,FILE,"C")=$G(^TMP($J,FILE,"C"))+1
.S ^TMP($J,FILE,"L")=$G(^TMP($J,FILE,"L"))+$P(^MDD(703.9,1,2,X,0),U,4)
.S ^TMP($J,FILE,"B")=$G(^TMP($J,FILE,"B"))+$P(^MDD(703.9,1,2,X,0),U,5)
Q
TOTALS ; Count by Status
N MDSTAT S MDSTAT=""
F S MDSTAT=$O(^MDD(703.9,1,2,"AS",MDSTAT)) Q:MDSTAT="" D
.S Y=0 F X=0:0 S X=$O(^MDD(703.9,1,2,"AS",MDSTAT,X)) Q:'X S Y=Y+1
.S MDSTAT(MDSTAT)=Y
W @IOF,!,"Conversion Totals",!,$TR($J("",35)," ","-")
W !,"Converted REAL Mode: ",$J(+$G(MDSTAT("CR")),9)
W !,"Converted TEST Mode: ",$J(+$G(MDSTAT("CT")),9)
W !,"Skipped: ",$J(+$G(MDSTAT("S")),9)
W !,"Error: ",$J(+$G(MDSTAT("E")),9)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDCVT 9739 printed Apr 09, 2024@20:47:37 Page 2
MDCVT ; HOIFO/DP/NCA - Medicine Package Conversion ;10/20/04 12:49
+1 ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
+2 ; Integration Agreements:
+3 ; IA# 2263 [Supported] XPAR parameter calls.
+4 ; IA# 2320 [Supported] %ZISH calls.
+5 ; IA#10031 [Supported] DDS call to bring up Screen Man
+6 ;
EN ; [Procedure] Main entry point to convert database to TIU notes
+1 NEW MDCNVT,MDDIR,MDFILE,MDREC,MDTEST,MDTIUI,MDXR,ORHFS,X,Y
+2 SET (MDCNVT("CR"),MDCNVT("CT"),MDCNVT("E"),MDCNVT("S"),MDCNVT("TOT"))=0
+3 IF $$GET^XPAR("SYS","MD MEDICINE CONVERTED",1)
WRITE !!,"Already Converted"
QUIT
+4 IF '$PIECE($GET(^MDD(703.9,1,0)),U,3)
WRITE !!,"No Administrative Closure Person."
QUIT
+5 SET MDTEST=+$PIECE($GET(^MDD(703.9,1,0)),U,2)'=1
+6 SET MDXR=$ORDER(^MDD(703.9,1,2,"AS",""))
IF MDXR=""
WRITE !!,"No Conversion List. Run Build Conversion List option."
QUIT
+7 ;
+8 WRITE @IOF,!,"Medicine to Clinical Procedure Conversion"
+9 KILL DIR
SET DIR(0)="YA"
+10 SET DIR("A")="Ok to continue? "
+11 SET DIR("A",1)="Running conversion in "_$SELECT(MDTEST:"TEST",1:"REAL")_" mode."
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)!$DATA(DIROUT)!(Y<1)
QUIT
+12 ;
+13 ; Set up the HFS variables
+14 SET MDFILE="MDCVT.TXT"
SET MDDIR=$PIECE($GET(^MDD(703.9,1,.1)),U)
+15 SET X=$$TESTHFS()
IF '+X
WRITE !!,"HFS Device Error: ",$PIECE(X,U,2)
QUIT
+16 ;
+17 ; Last Chance
+18 WRITE !
KILL DIR
SET DIR(0)="YA"
+19 SET DIR("A")="Ready to "_$SELECT(MDTEST:"test the conversion of",1:"convert")_" the Medicine Files? "
+20 SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)!$DATA(DIROUT)!(Y<1)
QUIT
+21 ;
+22 ; See if previous errors need to be reset
+23 WRITE !!,"Conversion in progress...",!
+24 DO RESET
+25 ;
+26 ; Set MDREC up here - This prevents loss on M error trap in EN1
+27 SET MDREC=0
+28 ;
+29 WRITE !?5,"[.] Indicates converted record"
+30 WRITE !?5,"[*] Indicates error in record",!!
+31 ;
EN1 ; [Procedure] Resumes on error via $ETRAP variable
+1 NEW $ESTACK,$ETRAP
SET $ETRAP="ERR^MDCVT"
+2 NEW MDCONS,MDECON,MDFDA,MDNODE,MDNOTE,MDOK,MDPR,MDR,MDR1,MDSTUD,MDUSR,MDX1
+3 FOR
SET MDREC=$ORDER(^MDD(703.9,1,2,"AS","R",MDREC))
if 'MDREC
QUIT
Begin DoDot:1
+4 SET MDPTR=$$GET1^DIQ(703.92,MDREC_",1,",.01)
if MDPTR=""
QUIT
+5 SET MDGBL=U_$PIECE(MDPTR,";",2)_$PIECE(MDPTR,";",1)_")"
+6 SET MDCNVT("TOT")=MDCNVT("TOT")+1
+7 IF '$PIECE($GET(^MDD(703.9,1,1,+$PIECE(MDGBL,"(",2),0)),U,3)
Begin DoDot:2
+8 DO SKIP(MDPTR,"Report type not marked for conversion")
+9 SET MDCNVT("S")=MDCNVT("S")+1
End DoDot:2
QUIT
+10 SET MDSTAT=$PIECE($GET(@MDGBL@("ES")),U,7)
+11 IF MDSTAT=""
Begin DoDot:2
+12 SET MDOK=+$PIECE($GET(^MDD(703.9,1,1,+$PIECE(MDGBL,"(",2),0)),U,4)
+13 if 'MDOK
DO LOGERR(MDPTR,"Unable to determine status")
End DoDot:2
if 'MDOK
QUIT
+14 IF MDSTAT="S"
DO SKIP(MDPTR,"Report Superseded")
SET MDCNVT("S")=MDCNVT("S")+1
QUIT
+15 IF MDSTAT["D"
DO LOGERR(MDPTR,"Report in Draft/Problem Draft status")
QUIT
+16 ;I MDSTAT="RNV" D LOGERR(MDPTR,"Report not verified") Q
+17 ; Progress indicator
IF MDTEST
WRITE "."
+18 ;
+19 ; Produce report using HFS device MDHFS
+20 SET %ZIS("HFSNAME")=MDDIR_MDFILE
SET %ZIS("HFSMODE")="W"
SET IOP="MDHFS;P-MDHFS"
+21 DO ^%ZIS
IF POP
DO LOGERR(MDPTR,"No HFS Access or device MDHFS")
QUIT
+22 SET ORHFS="SCRATCH"
+23 USE IO
DO EN^MCAPI(MDPTR,0)
DO ^%ZISC
+24 ;
+25 ; Fetch the report text
+26 KILL ^TMP($JOB)
+27 SET X=$$FTG^%ZISH(MDDIR,MDFILE,$NAME(^TMP($JOB,1)),2)
+28 ;
+29 ; Delete the Host File
+30 SET DELETE(MDFILE)=""
+31 SET X=$$DEL^%ZISH(MDDIR,"DELETE")
+32 ; Is it a valid report?
+33 SET LINES=$ORDER(^TMP($JOB,""),-1)
+34 SET BYTES=0
FOR X=0:0
SET X=$ORDER(^TMP($JOB,X))
if 'X
QUIT
SET BYTES=BYTES+$LENGTH(^(X))
+35 IF LINES<5&(^TMP($JOB,2)["BAD MEDICINE")
DO LOGERR(MDPTR,^TMP($JOB,2))
QUIT
+36 ;
+37 ; Get Legal header For Report
+38 SET RESULTS=$NAME(^TMP($JOB))
DO GETHDR^MDESPRT(.RESULTS,MDPTR)
+39 ;
+40 ; If test mode quit at this point
+41 IF MDTEST
DO FINISH(MDPTR,LINES,BYTES,"")
SET MDCNVT("CT")=MDCNVT("CT")+1
QUIT
+42 ;
+43 ; If real mode set to Unspecified Error status and proceed
+44 ;D LOGERR(MDPTR,"Unspecified Error")
+45 SET MDNODE=$GET(^MDD(703.9,1,2,+MDREC,0))
+46 SET MDNODE=$PIECE(MDNODE,U,1)
+47 ;
+48 ; Create the note
+49 SET MDTIUI=$$CONVERT^MDCVT1(MDNODE,$NAME(^TMP($JOB)))
+50 IF +MDTIUI'>0
DO LOGERR(MDPTR,"Couldn't create the TIU document")
QUIT
+51 ;
+52 ; Update Consults and Imaging
+53 ;
+54 DO UPD^MDCVT1(MDGBL,MDNODE,MDTIUI,MDTEST)
+55 ;
+56 ; Flag as finished
+57 ;
+58 DO FINISH(MDPTR,LINES,BYTES,MDTIUI)
SET MDCNVT("CR")=MDCNVT("CR")+1
End DoDot:1
+59 ;
+60 DO TOTALS^MDCVT1(.MDCNVT)
+61 QUIT
+62 ;
TESTHFS() ; Verify HFS is working properly
+1 NEW MDNOW
+2 SET %ZIS("HFSNAME")=MDDIR_MDFILE
SET %ZIS("HFSMODE")="W"
SET IOP="MDHFS;P-MDHFS"
+3 DO ^%ZIS
IF POP
WRITE !,"No HFS Access or missing device MDHFS"
QUIT 0
+4 SET X=1
Begin DoDot:1
+5 IF IOT'="HFS"
WRITE !,"Device MDHFS not of type HFS"
SET X=0
+6 IF IOST'="P-MDHFS"
WRITE !,"Missing Terminal Type P-MDHFS"
SET X=0
QUIT
+7 IF IOSL'=88
WRITE !,"Improper Page Length in Terminal Type P-MDHFS"
SET X=0
+8 IF IOM'=80
WRITE !,"Improper Page Width in Terminal Type P-MDHFS"
SET X=0
+9 IF IOF'="#"
WRITE !,"Improper Form Feed in Terminal Type P-MDHFS"
SET X=0
End DoDot:1
if 'X
QUIT 0
+10 ;
+11 DO NOW^%DTC
SET MDNOW=%
KILL %
+12 USE IO
WRITE !!,MDNOW
+13 DO ^%ZISC
+14 ;
+15 ; Fetch the text
+16 KILL ^TMP($JOB)
+17 SET X=$$FTG^%ZISH(MDDIR,MDFILE,$NAME(^TMP($JOB,1)),2)
+18 IF 'X
WRITE !,"Unable to retrieve data back from Host File"
QUIT 0
+19 IF ^TMP($JOB,3)'=MDNOW
WRITE !,"Error verifying data in Host File"
QUIT 0
+20 ;
+21 ; Delete the Host File
+22 SET DELETE(MDFILE)=""
+23 SET X=$$DEL^%ZISH(MDDIR,"DELETE")
+24 IF X'=1
WRITE !,"Unable delete Host File"
QUIT 0
+25 QUIT 1
+26 ;
ERR ; M Error trap submodule to document error and continue
+1 DO LOGERR(MDPTR,$ECODE)
+2 ; Close device if using the HFS
IF $GET(ION)="MDHFS"
DO ^%ZISC
+3 GOTO EN1
+4 ;
FINISH(MDPTR,LINES,BYTES,TIUIEN) ; Update status to converted
+1 NEW MDFDA,MDIEN,MDIENS
+2 SET MDIEN=$ORDER(^MDD(703.9,1,2,"B",MDPTR,0))
+3 IF MDIEN<1
WRITE !,"Error, no log entry ",MDPTR
QUIT
+4 SET MDIENS=MDIEN_",1,"
+5 IF MDTEST
SET MDFDA(703.92,MDIENS,.02)="CT"
+6 IF '$TEST
SET MDFDA(703.92,MDIENS,.02)="CR"
+7 SET MDFDA(703.92,MDIENS,.03)=TIUIEN
+8 SET MDFDA(703.92,MDIENS,.04)=LINES
+9 SET MDFDA(703.92,MDIENS,.05)=BYTES
+10 SET MDFDA(703.92,MDIENS,.1)=LINES_" lines, "_BYTES_" bytes"
+11 DO FILE^DIE("","MDFDA")
+12 QUIT
+13 ;
LOGERR(MDPTR,ERRMSG) ; Log conversion error
+1 NEW MDFDA,MDIEN,MDIENS
+2 SET MDIEN=$ORDER(^MDD(703.9,1,2,"B",MDPTR,0))
+3 IF MDIEN<1
WRITE !,"Error, no log entry ",MDPTR
QUIT
+4 SET MDIENS=MDIEN_",1,"
+5 SET MDFDA(703.92,MDIENS,.02)="E"
+6 SET MDFDA(703.92,MDIENS,.1)=$TRANSLATE(ERRMSG,U,"~")
+7 DO FILE^DIE("","MDFDA")
+8 ; Progress indicator
WRITE "*"
+9 QUIT
+10 ;
RESET ; Reset error status reports to READY TO CONVERT
+1 NEW MDIEN
SET MDIEN=0
+2 ; Check for real mode and convert test conversions
+3 IF 'MDTEST
FOR
SET MDIEN=$ORDER(^MDD(703.9,1,2,"AS","CT",MDIEN))
if 'MDIEN
QUIT
Begin DoDot:1
+4 NEW MDFDA
+5 SET MDFDA(703.92,MDIEN_",1,",.02)="R"
+6 DO FILE^DIE("","MDFDA")
End DoDot:1
+7 ; Regardless of mode switch skipped back to ready
+8 FOR
SET MDIEN=$ORDER(^MDD(703.9,1,2,"AS","S",MDIEN))
if 'MDIEN
QUIT
Begin DoDot:1
+9 NEW MDFDA
+10 SET MDFDA(703.92,MDIEN_",1,",.02)="R"
+11 DO FILE^DIE("","MDFDA")
End DoDot:1
+12 ; Regardless of mode switch errors back to ready
+13 FOR
SET MDIEN=$ORDER(^MDD(703.9,1,2,"AS","E",MDIEN))
if 'MDIEN
QUIT
Begin DoDot:1
+14 NEW MDFDA
+15 SET MDFDA(703.92,MDIEN_",1,",.02)="R"
+16 DO FILE^DIE("","MDFDA")
End DoDot:1
+17 QUIT
+18 ;
REBUILD ; [Procedure] Build the file manually
+1 NEW MDROOT
+2 SET X=$PIECE(^MDD(703.9,0),U,1,2)_U_U
KILL ^MDD(703.9)
SET ^MDD(703.9,0)=X
+3 SET MDROOT=$NAME(^MDD(703.9,1))
+4 SET @MDROOT@(0)="DEFAULT"
+5 SET @MDROOT@(1,0)="^703.91P^^"
+6 FOR X=691,691.1,691.5,691.6,691.7,691.8,694,694.5,698,698.1,698.2,698.3,699,699.5,700,701
SET @MDROOT@(1,X,0)=X
+7 SET DA=1
SET DIK="^MDD(703.9,"
DO IXALL^DIK
KILL DA,DIK
+8 QUIT
+9 ;
SETUP ; [Procedure]
+1 IF '$ORDER(^MDD(703.9,0))
WRITE !,"Initializing..."
DO REBUILD
DO SETDEF^MDSTATU
+2 SET DDSFILE=703.9
SET DR="[MD MAIN]"
SET DA=1
DO ^DDS
+3 QUIT
+4 ;
SKIP(MDPTR,REASON) ; [Procedure] Skip Report
+1 NEW MDFDA,MDIEN,MDIENS
+2 SET MDIEN=$ORDER(^MDD(703.9,1,2,"B",MDPTR,0))
+3 IF MDIEN<1
WRITE !,"Error, no log entry ",MDPTR
QUIT
+4 SET MDIENS=MDIEN_",1,"
+5 SET MDFDA(703.92,MDIENS,.02)="S"
+6 SET MDFDA(703.92,MDIENS,.1)=$TRANSLATE(REASON,U,"~")
+7 DO FILE^DIE("","MDFDA")
+8 QUIT
+9 ;
SYNC(MDPTR) ; Make sure entry exists
+1 NEW MDFDA
+2 if $ORDER(^MDD(703.9,1,2,"B",MDPTR,0))
QUIT
+3 if $ORDER(^MDD(702,"ACONV",MDPTR,0))
QUIT
+4 SET MDFDA(703.92,"+1,1,",.01)=MDPTR
+5 SET MDFDA(703.92,"+1,1,",.02)="R"
+6 DO UPDATE^DIE("","MDFDA")
+7 QUIT
+8 ;
LOCKOUT ; Lockout Options and set API Flag
+1 DO ^MDOUTOR
+2 QUIT
+3 ;
STATUS(MDPTR) ; [Procedure] Return status of VPtr
+1 SET X=$ORDER(^MDD(703.9,1,2,"B",MDPTR,0))
+2 ; Return actual status
IF X
QUIT $PIECE($GET(^MDD(703.9,1,2,X,0)),U,2)
+3 NEW MDFDA,MDIEN,MDMSG
+4 SET MDFDA(703.92,"+1,1,",.01)=MDPTR
+5 SET MDFDA(703.92,"+1,1,",.02)="N"
+6 DO UPDATE^DIE("","MDFDA","MDIEN","MDMSG")
+7 IF $GET(MDIEN(1))<1
WRITE !,"Error adding to conversion log ",MDPTR
QUIT -1
+8 QUIT "N"
+9 ;
SUMMARY ; Disk space requirements
+1 NEW FILE,LP,TOTB,TOTC,TOTL,X
+2 WRITE !!,"Summarizing..."
+3 KILL ^TMP($JOB)
+4 SET (TOTL,TOTC,TOTB)=0
+5 ; will be CT or CR
SET MDSTAT=$ORDER(^MDD(703.9,1,2,"AS","C"))
+6 IF MDSTAT'["C"
WRITE !!,"No report was converted. You MUST run the conversion in TEST or",!,"REAL mode first to be able to display the Disk Space Requirements."
QUIT
+7 DO S1
IF MDSTAT="CR"
SET MDSTAT="CT"
DO S1
+8 WRITE @IOF,!,"FILE",?42,$JUSTIFY("COUNT",8),?52,$JUSTIFY("LINES",8),?62,$JUSTIFY("BYTES",12)
+9 WRITE !,$TRANSLATE($JUSTIFY("",79)," ","-")
+10 SET X=""
FOR
SET X=$ORDER(^TMP($JOB,X))
if X=""
QUIT
Begin DoDot:1
+11 WRITE !,$EXTRACT($PIECE(@X,U,1),1,40)
+12 WRITE ?42,$JUSTIFY(^TMP($JOB,X,"C"),8)
+13 WRITE ?52,$JUSTIFY(^TMP($JOB,X,"L"),8)
+14 WRITE ?62,$JUSTIFY(^TMP($JOB,X,"B"),12)
+15 SET TOTC=TOTC+^TMP($JOB,X,"C")
+16 SET TOTL=TOTL+^TMP($JOB,X,"L")
+17 SET TOTB=TOTB+^TMP($JOB,X,"B")
End DoDot:1
+18 WRITE !?42,$TRANSLATE($JUSTIFY("",37)," ","=")
+19 WRITE !?42,$JUSTIFY(TOTC,8),?52,$JUSTIFY(TOTL,8),?62,$JUSTIFY(TOTB,12)
KILL ^TMP($JOB)
+20 QUIT
+21 ;
S1 ; Loop for both CT or CR Statuses
+1 NEW X
SET X=""
FOR
SET X=$ORDER(^MDD(703.9,1,2,"AS",MDSTAT,X))
if X=""
QUIT
Begin DoDot:1
+2 SET FILE=$PIECE($GET(^MDD(703.9,1,2,X,0)),U,1)
+3 SET FILE=U_$PIECE(FILE,";",2)_"0)"
+4 SET ^TMP($JOB,FILE,"C")=$GET(^TMP($JOB,FILE,"C"))+1
+5 SET ^TMP($JOB,FILE,"L")=$GET(^TMP($JOB,FILE,"L"))+$PIECE(^MDD(703.9,1,2,X,0),U,4)
+6 SET ^TMP($JOB,FILE,"B")=$GET(^TMP($JOB,FILE,"B"))+$PIECE(^MDD(703.9,1,2,X,0),U,5)
End DoDot:1
+7 QUIT
TOTALS ; Count by Status
+1 NEW MDSTAT
SET MDSTAT=""
+2 FOR
SET MDSTAT=$ORDER(^MDD(703.9,1,2,"AS",MDSTAT))
if MDSTAT=""
QUIT
Begin DoDot:1
+3 SET Y=0
FOR X=0:0
SET X=$ORDER(^MDD(703.9,1,2,"AS",MDSTAT,X))
if 'X
QUIT
SET Y=Y+1
+4 SET MDSTAT(MDSTAT)=Y
End DoDot:1
+5 WRITE @IOF,!,"Conversion Totals",!,$TRANSLATE($JUSTIFY("",35)," ","-")
+6 WRITE !,"Converted REAL Mode: ",$JUSTIFY(+$GET(MDSTAT("CR")),9)
+7 WRITE !,"Converted TEST Mode: ",$JUSTIFY(+$GET(MDSTAT("CT")),9)
+8 WRITE !,"Skipped: ",$JUSTIFY(+$GET(MDSTAT("S")),9)
+9 WRITE !,"Error: ",$JUSTIFY(+$GET(MDSTAT("E")),9)
+10 QUIT
+11 ;
