- 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 Jan 18, 2025@02:43:52 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 ;