- MDCVT1 ; HOIFO/NCA - Medicine Package Conversion (Cont.) ;1/6/05 15:12
- ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
- ; Integration Agreements:
- ; IA# 4630 [Subscription] Calls to GMRCCP.
- ; IA# 3535 [Subscription] Calls to TIUSRVP.
- ; IA# 4508 [Subscription] Call to TIUSRVPT.
- ; IA# 4588 [Subscription] Call to MAGMC2CP
- ; IA# 2729 [Supported] Calls to XMXAPI.
- ; IA#10063 [Supported] %ZTLOAD routine calls.
- ;
- CONVERT(MDNOD,MDGLB) ; [Function] Convert Medicine Report to TIU Document
- ; Input parameters
- ; 1. MDNOD [Literal/Required]
- ; 2. MDGLB [Reference/Required]
- ;
- ; Returns the TIU Note IEN
- ; or 0 if report is skipped because Convert flag is set to "NO" or Report Converted
- ; or -1^Error message
- ; (Note: Error messages will be filed in Subfile 703.92 field .1)
- ;
- N MDCONV,MDEX,MDFIEN,MDFILE,MDFLG,MDGN,MDP,MDPROC,MDRES,MDTITL,MDUSER,MDX
- S (MDGN,MDP)=MDNOD
- S (MDEX,MDRES)="",MDFLG=0
- S MDFIEN=+MDP Q:'MDFIEN "-1^No IEN for "_MDP
- S MDFILE=+$P(MDP,"MCAR(",2) Q:'MDFILE "-1^No File Number for "_MDP
- I $O(^MDD(702,"ACONV",MDFIEN_";MCAR("_MDFILE_",",0)) Q "-1^Already Converted."
- S MDPAT=$$GET1^DIQ(MDFILE,MDFIEN_",","MEDICAL PATIENT","I")
- I 'MDPAT S MDPAT=$$GET1^DIQ(MDFILE,MDFIEN_",","PATIENT","I")
- I 'MDPAT Q "-1^No Medical Patient."
- ; Get Medicine Parameter
- S MDPROC=$G(^MDD(703.9,1,1,MDFILE,0))
- ; Get CP Definition and Convert?
- S MDCONV=$P(MDPROC,"^",3) I '+MDCONV D SKIP^MDCVT(MDP,"CONVERT Y/N flag set to No.") Q 0
- S MDTITL=$P(MDPROC,"^",5) S:'MDTITL MDTITL=$$LOCATN^MDSTATU(MDGN)
- Q:MDTITL'>0 "-1^No Historical Note Title."
- S MDPROC=$P(MDPROC,"^",2) S:'MDPROC MDPROC=$$LOCATP^MDSTATU(MDGN)
- Q:'MDPROC "-1^No CP definition for "_MDP
- S MDUSER=$P($G(^MDD(703.9,1,0)),U,3) I 'MDUSER Q "-1^No Administrative Closure User Designated."
- ; Get Existing TIU Note
- S MDX=$O(^MDD(703.9,1,2,"B",MDP,0))
- I +MDX S MDX=$G(^MDD(703.9,1,2,+MDX,0))
- I +$P(MDX,"^",3) S MDEX=+$P(MDX,"^",3) Q MDEX
- ; Create TIU Note
- S MDRES=$$NEWTIU(MDFILE,MDPAT,MDFIEN,MDPROC,MDTITL,MDUSER,.MDGLB) I +MDRES<1 D LOGERR^MDCVT(MDP,$P(MDRES,"^",2)) S $P(MDRES,"^")=-1 Q MDRES
- Q +MDRES
- ;
- NEWTIU(MDFILE,MDPAT,MDFIEN,MDPROC,MDTITL,MDU,MDGLB) ; [Function] Create New TIU Note for Medicine Reports
- ; Input parameters
- ; 1. MDFILE [Literal/Required]
- ; 2. MDPAT [Literal/Required]
- ; 3. MDFIEN [Literal/Required]
- ; 4. MDPROC [Literal/Required]
- ; 5. MDTITL [Literal/Required]
- ; 6. MDGLB [Reference/Required]
- ;
- N MDADD,MDCHKI,MDCODE,MDD,MDDT,MDERR,MDFDA,MDIEN,MDIENS,MDK,MDLOC,MDNOTE,MDRET,MDSSTR,MDVST,MDVSTR,MDWP
- ; Get Hospital Location
- S MDLOC=$$HOSP^MDSTATU(MDFIEN_";MCAR("_MDFILE)
- I 'MDLOC S MDLOC=$$GET1^DIQ(702.01,+MDPROC_",",.05,"I")
- Q:'MDLOC "0^No Hospital Location."
- S MDCODE=$$GET1^DIQ(MDFILE,MDFIEN_",","SUMMARY","I")
- I MDCODE'="" S MDCODE=$S(MDCODE="N":1,MDCODE="A":2,MDCODE="B":3,MDCODE="MI":2,MDCODE="MO":2,MDCODE="S":2,1:4)
- E S MDCHKI=$$CHKINT(MDFILE,MDFIEN),MDCODE=$S(+MDCHKI:(MDCHKI+4),1:"")
- S MDDT=$$GET1^DIQ(MDFILE,MDFIEN_",",.01,"I")
- ; Set Un-dictated status
- ;S MDWP(.05)=1
- ; Set Author/Dictator and Entered By
- ;S MDWP(1202)=MDU,MDWP(1302)=MDU
- ; Set Procedure Summary Code and Date/Time of Procedure
- S MDWP(70201)=MDCODE,MDWP(70202)=MDDT
- F MDK=0:0 S MDK=$O(@MDGLB@(MDK)) Q:'MDK S MDWP("TEXT",MDK,0)=$G(@MDGLB@(MDK))
- D NOW^%DTC S MDD=% K %
- S MDFDA(702,"+1,",.01)=MDPAT
- S MDFDA(702,"+1,",.02)=MDD
- S MDFDA(702,"+1,",.03)=DUZ
- S MDFDA(702,"+1,",.04)=MDPROC
- S MDFDA(702,"+1,",.09)=4 ; Status = Checked-In
- D UPDATE^DIE("","MDFDA","MDIEN","MDERR") Q:$D(MDERR)
- S MDRET=$$EN1^MDPCE(MDIEN(1),MDDT,MDPROC_"^"_MDLOC,"E","A")
- I +MDRET S MDVST=+MDRET,MDSSTR=$P(MDRET,"^",2),MDVSTR=$P(MDSSTR,";",3)_";"_$P(MDSSTR,";",2)_";"_$P(MDSSTR,";")
- I +MDRET<1 D DELETE(MDIEN(1)) Q MDRET
- S MDNOTE="" D MAKE^TIUSRVP(.MDNOTE,MDPAT,MDTITL,$P(MDVSTR,";",2),MDLOC,MDVST,.MDWP,MDVSTR,1,1)
- ; Add the TIU Document Reference
- S MDIENS=MDIEN(1)_","
- I +MDNOTE S MDFDA(702,MDIENS,.06)=MDNOTE D FILE^DIE("","MDFDA","MDERR")
- I +MDNOTE'>0 D DELETE(MDIEN(1))
- Q MDNOTE
- ;
- UPD(MDGB,MDNOD,MDTI,MDT) ; Do consults and Imaging update and log response
- N MDCONS,MDECON,MDUSR,MDEFLG,MDIMG,MDNOTE,MDR,MDR1,MDRET,MDSTUD,MDTT,MDWP,MDX1 S (MDEFLG,MDRET)=0
- ; Get the existing study
- ;
- S MDSTUD=$O(^MDD(702,"ATIU",+MDTI,0)) Q:'MDSTUD
- ;
- ;Get existing consult
- ;
- S MDECON=$$GET1^DIQ(702,MDSTUD_",",.05,"I")
- ;
- ; Get Administrative Closure Person
- ;
- S MDUSR=$P($G(^MDD(703.9,1,0)),U,3) Q:'MDUSR
- S MDTT=$S(+$G(MDT)>0:0,1:1)
- S MDCONS=$$CVTCONS^MDCVT1(MDTT,MDNOD,+MDTI)
- I +MDCONS<0&($P(MDCONS,U,2)'["No MC results sent") D LOGERR^MDCVT(MDNOD,"Consults error: "_$P(MDCONS,U,2)) Q
- I +MDCONS>0 K MDWP I +$P(MDCONS,U,3) D Q:MDEFLG
- .S MDWP(1405)=+$P(MDCONS,U,3)_";GMR(123,"
- .D UPDATE^TIUSRVP(.MDNOTE,+MDTI,.MDWP,1)
- .I +MDNOTE<1 D LOGERR^MDCVT(MDNOD,"COULDN'T UPDATE THE NOTE") S MDEFLG=1 Q
- .I +$P(MDCONS,U,3) S MDFDA(702,MDSTUD_",",.05)=+$P(MDCONS,U,3) D FILE^DIE("","MDFDA")
- .Q
- ; Do imaging update and log response
- Q:$$GET1^DIQ(702,MDSTUD_",",.09,"I")=3
- I $O(@MDGB@(2005,0)) D Q:MDRET<0 ; Quit on Imaging error
- .S (MDIMG,MDX1)=0
- .F S MDX1=$O(@MDGB@(2005,MDX1)) Q:'MDX1 D Q:MDRET<0
- ..S MDIMG=+@MDGB@(2005,MDX1,0)
- ..S MDRET=$$CVTIMG(MDTT,MDNOD,MDTI,MDIMG)
- ..D:MDRET<0 LOGERR^MDCVT(MDNOD,"Imaging error: "_$P(MDRET,U,2))
- Q:MDRET<0 K MDFDA S MDFDA(702,MDSTUD_",",.09)=3,MDFDA(702,MDSTUD_",",.3)=MDNOD D FILE^DIE("","MDFDA") W "."
- ;
- ; Close the record with Administrative Closure
- S (MDR,MDR1)=""
- I +MDTI D ADMNCLOS^TIUSRVPT(.MDR,+MDTI,"M",MDUSR) I '+MDR D DELETE^TIUSRVP(.MDR1,+MDTI) D LOGERR^MDCVT(MDNOD,"Can't Administrative close document")
- Q
- PROC(MDX5,MDX6) ; Get Medicine Procedure Name
- N LL,LL6,LL8
- I MDX5="MCAR(699" S LL=$P($G(^MCAR(699,MDX6,0)),U,12) Q:LL'>0 S LL=$P($G(^MCAR(697.2,+LL,0)),U) Q LL
- I MDX5="MCAR(699.5" D
- .S LL6=$P($G(^MCAR(699.5,MDX6,0)),U,6),LL8=$P($G(^MCAR(699.5,MDX6,0)),U,8)
- .S LL=$P($G(^MCAR(699.5,MDX6,0)),U,6) Q:'LL S LL=$P($G(^MCAR(697.2,LL,0)),U) Q LL
- I MDX5[694 S LL=$P($G(^MCAR(694,MDX6,0)),U,3) Q:'LL S LL=$P(^MCAR(697.2,LL,0),U) Q LL
- S LL=$O(^MCAR(697.2,"C",MDX5,0)),LL=$P(^MCAR(697.2,LL,0),U,1)
- Q LL
- CVTIMG(MDTST,MDN,MDTIU,MDIMAGES) ; Call Imaging API
- Q $$TIU^MAGMC2CP(MDTST,MDN,MDTIU,.MDIMAGES)
- CVTCONS(MDTST,MDN,MDTIU) ; Call Consults API
- Q $$MCCNVT^GMRCCP(MDTST,MDN,MDTIU)
- CHKINT(MDFL,MDMREC) ; Check to see if record from Medical Device
- ; Returns 1 or 0
- N MDN1,MDF
- I MDFL=691 S MDN1=$G(^MCAR(691,+MDMREC,10,0)) I +$P(MDN1,U,3)&($P(MDN1,U,3)>1) Q 1
- I MDFL=691.1 S MDN1=$G(^MCAR(691.1,+MDMREC,43,0)) I +$P(MDN1,U,3)&($P(MDN1,U,3)>1) Q 1
- I MDFL=691.5 S MDN1=$G(^MCAR(691.5,+MDMREC,9,0)) I +$P(MDN1,U,3)&($P(MDN1,U,3)>1) Q 1
- I MDFL=691.6 S MDN1=$G(^MCAR(691.6,+MDMREC,7,0)) I +$P(MDN1,U,3)&($P(MDN1,U,3)>1) Q 1
- I MDFL=691.8 S MDN1=$G(^MCAR(691.8,+MDMREC,12,0)) I +$P(MDN1,U,3)&($P(MDN1,U,3)>1) Q 1
- I MDFL=698.3 S MDN1=$G(^MCAR(698.3,+MDMREC,10,0)) I +$P(MDN1,U,3)&($P(MDN1,U,3)>1) Q 1
- I MDFL=699 S MDN1=$G(^MCAR(699,+MDMREC,33,0)) I +$P(MDN1,U,3)&($P(MDN1,U,3)>1) Q 1
- I MDFL=700 S MDF=0 D Q:MDF 1
- .S MDN1=$G(^MCAR(700,+MDMREC,25,0))
- .I +$P(MDN1,U,3)&($P(MDN1,U,3)>1) S MDF=1 Q
- .S MDN1=$G(^MCAR(700,+MDMREC,3,0))
- .I +$P(MDN1,U,3)&($P(MDN1,U,3)>1) S MDF=1 Q
- .S MDN1=$G(^MCAR(700,+MDMREC,4,0))
- .I +$P(MDN1,U,3)&($P(MDN1,U,3)>1) S MDF=1 Q
- I +$P($G(^MCAR(MDFL,+MDMREC,2005,0)),U,4)>0 Q 1
- Q 0
- BLD() ; Build the list of reports to convert
- W ! K DIR S DIR(0)="YA",DIR("A")="Build the list of reports to convert? "
- S DIR("A",1)="You can rebuild the list to check for new Medicine Reports that"
- S DIR("A",2)="may have been added since the last time you ran the Build Conversion List.",DIR("B")="NO" D ^DIR K DIR
- ;
- Q:Y<1 1 ; User said no to re-build
- Q:$D(DIRUT)!$D(DIROUT)!(Y<1) 0 ; User has cancelled
- ;
- K DIR S DIR(0)="YA",DIR("A")="Queue the conversion list build? ",DIR("B")="YES" D ^DIR K DIR
- I Y=0 D QBLD Q 1 ; User has opted to do it now
- I Y=1 D Q 0 ; User has queued the build
- .S ZTRTN="QBLD^MDCVT1"
- .S ZTDESC="Medicine Conversion List Build"
- .S ZTREQ="@",ZTSAVE("ZTREQ")="",MDQUE=1,MDDUZ=DUZ,ZTSAVE("MDDUZ")="",ZTSAVE("MDQUE")=""
- .S (ZTDTH,ZTIO)=""
- .D ^%ZTLOAD
- .I $G(ZTSK) W "Task Queued"
- .E W "Task Cancelled"
- Q 0 ; User cancelled out of the queueing
- ;
- QBLD ; Queued entry point for re-build
- L +(^MDD(703.9,1,2)):5 E Q
- N MDGBL,MDPTR,MDFDA,MDFL,MDIEN,MDY,X2
- S X2="" F S X2=$O(^MDD(703.9,1,1,X2)) Q:X2="" S MDY=$G(^(X2,0)) D
- .Q:'+$P(MDY,U,3)
- .S MDFL=$P(MDY,U),MDGBL="^MCAR("_MDFL_",""B"")"
- .F S MDGBL=$Q(@MDGBL) Q:MDGBL="" Q:$QS(MDGBL,2)'="B" D
- ..Q:'$P($G(^MCAR(MDFL,+$QS(MDGBL,4),0)),U,2)
- ..S MDPTR=$QS(MDGBL,4)_";MCAR("_MDFL_","
- ..D SYNC^MDCVT(MDPTR)
- L -(^MDD(703.9,1,2))
- I +$G(MDQUE) D
- .N TXT,XMTO,XMBODY,XMDUZ,XMSUBJ
- .S XMINSTR("FROM")=.5,XMSUBJ="Conversion List"
- .S XMTO=$G(MDDUZ) Q:'XMTO
- .S TXT(1)="The Queued Conversion List is finished."
- .S TXT(2)="You can run the Medicine report conversion process.",XMBODY="TXT"
- .D SENDMSG^XMXAPI(DUZ,XMSUBJ,XMBODY,XMTO,.XMINSTR)
- .K MDQUE,MDDUZ
- Q
- DELETE(MDIN) ; Delete study upon unsuccessful Note Creation
- N MDFDA
- S MDFDA(702,MDIN_",",.01)=""
- D FILE^DIE("","MDFDA")
- N DA,DIK S DA=+MDIN,DIK="^MDD(702," D ^DIK
- Q
- TOTALS(MDSTAT) ; Count by Status
- S MDSTAT("E")=0
- S MDSTAT("E")=MDSTAT("TOT")-(MDSTAT("S")+MDSTAT("CR")+MDSTAT("CT"))
- 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[HMDCVT1 9717 printed Jan 18, 2025@02:43:53 Page 2
- MDCVT1 ; HOIFO/NCA - Medicine Package Conversion (Cont.) ;1/6/05 15:12
- +1 ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
- +2 ; Integration Agreements:
- +3 ; IA# 4630 [Subscription] Calls to GMRCCP.
- +4 ; IA# 3535 [Subscription] Calls to TIUSRVP.
- +5 ; IA# 4508 [Subscription] Call to TIUSRVPT.
- +6 ; IA# 4588 [Subscription] Call to MAGMC2CP
- +7 ; IA# 2729 [Supported] Calls to XMXAPI.
- +8 ; IA#10063 [Supported] %ZTLOAD routine calls.
- +9 ;
- CONVERT(MDNOD,MDGLB) ; [Function] Convert Medicine Report to TIU Document
- +1 ; Input parameters
- +2 ; 1. MDNOD [Literal/Required]
- +3 ; 2. MDGLB [Reference/Required]
- +4 ;
- +5 ; Returns the TIU Note IEN
- +6 ; or 0 if report is skipped because Convert flag is set to "NO" or Report Converted
- +7 ; or -1^Error message
- +8 ; (Note: Error messages will be filed in Subfile 703.92 field .1)
- +9 ;
- +10 NEW MDCONV,MDEX,MDFIEN,MDFILE,MDFLG,MDGN,MDP,MDPROC,MDRES,MDTITL,MDUSER,MDX
- +11 SET (MDGN,MDP)=MDNOD
- +12 SET (MDEX,MDRES)=""
- SET MDFLG=0
- +13 SET MDFIEN=+MDP
- if 'MDFIEN
- QUIT "-1^No IEN for "_MDP
- +14 SET MDFILE=+$PIECE(MDP,"MCAR(",2)
- if 'MDFILE
- QUIT "-1^No File Number for "_MDP
- +15 IF $ORDER(^MDD(702,"ACONV",MDFIEN_";MCAR("_MDFILE_",",0))
- QUIT "-1^Already Converted."
- +16 SET MDPAT=$$GET1^DIQ(MDFILE,MDFIEN_",","MEDICAL PATIENT","I")
- +17 IF 'MDPAT
- SET MDPAT=$$GET1^DIQ(MDFILE,MDFIEN_",","PATIENT","I")
- +18 IF 'MDPAT
- QUIT "-1^No Medical Patient."
- +19 ; Get Medicine Parameter
- +20 SET MDPROC=$GET(^MDD(703.9,1,1,MDFILE,0))
- +21 ; Get CP Definition and Convert?
- +22 SET MDCONV=$PIECE(MDPROC,"^",3)
- IF '+MDCONV
- DO SKIP^MDCVT(MDP,"CONVERT Y/N flag set to No.")
- QUIT 0
- +23 SET MDTITL=$PIECE(MDPROC,"^",5)
- if 'MDTITL
- SET MDTITL=$$LOCATN^MDSTATU(MDGN)
- +24 if MDTITL'>0
- QUIT "-1^No Historical Note Title."
- +25 SET MDPROC=$PIECE(MDPROC,"^",2)
- if 'MDPROC
- SET MDPROC=$$LOCATP^MDSTATU(MDGN)
- +26 if 'MDPROC
- QUIT "-1^No CP definition for "_MDP
- +27 SET MDUSER=$PIECE($GET(^MDD(703.9,1,0)),U,3)
- IF 'MDUSER
- QUIT "-1^No Administrative Closure User Designated."
- +28 ; Get Existing TIU Note
- +29 SET MDX=$ORDER(^MDD(703.9,1,2,"B",MDP,0))
- +30 IF +MDX
- SET MDX=$GET(^MDD(703.9,1,2,+MDX,0))
- +31 IF +$PIECE(MDX,"^",3)
- SET MDEX=+$PIECE(MDX,"^",3)
- QUIT MDEX
- +32 ; Create TIU Note
- +33 SET MDRES=$$NEWTIU(MDFILE,MDPAT,MDFIEN,MDPROC,MDTITL,MDUSER,.MDGLB)
- IF +MDRES<1
- DO LOGERR^MDCVT(MDP,$PIECE(MDRES,"^",2))
- SET $PIECE(MDRES,"^")=-1
- QUIT MDRES
- +34 QUIT +MDRES
- +35 ;
- NEWTIU(MDFILE,MDPAT,MDFIEN,MDPROC,MDTITL,MDU,MDGLB) ; [Function] Create New TIU Note for Medicine Reports
- +1 ; Input parameters
- +2 ; 1. MDFILE [Literal/Required]
- +3 ; 2. MDPAT [Literal/Required]
- +4 ; 3. MDFIEN [Literal/Required]
- +5 ; 4. MDPROC [Literal/Required]
- +6 ; 5. MDTITL [Literal/Required]
- +7 ; 6. MDGLB [Reference/Required]
- +8 ;
- +9 NEW MDADD,MDCHKI,MDCODE,MDD,MDDT,MDERR,MDFDA,MDIEN,MDIENS,MDK,MDLOC,MDNOTE,MDRET,MDSSTR,MDVST,MDVSTR,MDWP
- +10 ; Get Hospital Location
- +11 SET MDLOC=$$HOSP^MDSTATU(MDFIEN_";MCAR("_MDFILE)
- +12 IF 'MDLOC
- SET MDLOC=$$GET1^DIQ(702.01,+MDPROC_",",.05,"I")
- +13 if 'MDLOC
- QUIT "0^No Hospital Location."
- +14 SET MDCODE=$$GET1^DIQ(MDFILE,MDFIEN_",","SUMMARY","I")
- +15 IF MDCODE'=""
- SET MDCODE=$SELECT(MDCODE="N":1,MDCODE="A":2,MDCODE="B":3,MDCODE="MI":2,MDCODE="MO":2,MDCODE="S":2,1:4)
- +16 IF '$TEST
- SET MDCHKI=$$CHKINT(MDFILE,MDFIEN)
- SET MDCODE=$SELECT(+MDCHKI:(MDCHKI+4),1:"")
- +17 SET MDDT=$$GET1^DIQ(MDFILE,MDFIEN_",",.01,"I")
- +18 ; Set Un-dictated status
- +19 ;S MDWP(.05)=1
- +20 ; Set Author/Dictator and Entered By
- +21 ;S MDWP(1202)=MDU,MDWP(1302)=MDU
- +22 ; Set Procedure Summary Code and Date/Time of Procedure
- +23 SET MDWP(70201)=MDCODE
- SET MDWP(70202)=MDDT
- +24 FOR MDK=0:0
- SET MDK=$ORDER(@MDGLB@(MDK))
- if 'MDK
- QUIT
- SET MDWP("TEXT",MDK,0)=$GET(@MDGLB@(MDK))
- +25 DO NOW^%DTC
- SET MDD=%
- KILL %
- +26 SET MDFDA(702,"+1,",.01)=MDPAT
- +27 SET MDFDA(702,"+1,",.02)=MDD
- +28 SET MDFDA(702,"+1,",.03)=DUZ
- +29 SET MDFDA(702,"+1,",.04)=MDPROC
- +30 ; Status = Checked-In
- SET MDFDA(702,"+1,",.09)=4
- +31 DO UPDATE^DIE("","MDFDA","MDIEN","MDERR")
- if $DATA(MDERR)
- QUIT
- +32 SET MDRET=$$EN1^MDPCE(MDIEN(1),MDDT,MDPROC_"^"_MDLOC,"E","A")
- +33 IF +MDRET
- SET MDVST=+MDRET
- SET MDSSTR=$PIECE(MDRET,"^",2)
- SET MDVSTR=$PIECE(MDSSTR,";",3)_";"_$PIECE(MDSSTR,";",2)_";"_$PIECE(MDSSTR,";")
- +34 IF +MDRET<1
- DO DELETE(MDIEN(1))
- QUIT MDRET
- +35 SET MDNOTE=""
- DO MAKE^TIUSRVP(.MDNOTE,MDPAT,MDTITL,$PIECE(MDVSTR,";",2),MDLOC,MDVST,.MDWP,MDVSTR,1,1)
- +36 ; Add the TIU Document Reference
- +37 SET MDIENS=MDIEN(1)_","
- +38 IF +MDNOTE
- SET MDFDA(702,MDIENS,.06)=MDNOTE
- DO FILE^DIE("","MDFDA","MDERR")
- +39 IF +MDNOTE'>0
- DO DELETE(MDIEN(1))
- +40 QUIT MDNOTE
- +41 ;
- UPD(MDGB,MDNOD,MDTI,MDT) ; Do consults and Imaging update and log response
- +1 NEW MDCONS,MDECON,MDUSR,MDEFLG,MDIMG,MDNOTE,MDR,MDR1,MDRET,MDSTUD,MDTT,MDWP,MDX1
- SET (MDEFLG,MDRET)=0
- +2 ; Get the existing study
- +3 ;
- +4 SET MDSTUD=$ORDER(^MDD(702,"ATIU",+MDTI,0))
- if 'MDSTUD
- QUIT
- +5 ;
- +6 ;Get existing consult
- +7 ;
- +8 SET MDECON=$$GET1^DIQ(702,MDSTUD_",",.05,"I")
- +9 ;
- +10 ; Get Administrative Closure Person
- +11 ;
- +12 SET MDUSR=$PIECE($GET(^MDD(703.9,1,0)),U,3)
- if 'MDUSR
- QUIT
- +13 SET MDTT=$SELECT(+$GET(MDT)>0:0,1:1)
- +14 SET MDCONS=$$CVTCONS^MDCVT1(MDTT,MDNOD,+MDTI)
- +15 IF +MDCONS<0&($PIECE(MDCONS,U,2)'["No MC results sent")
- DO LOGERR^MDCVT(MDNOD,"Consults error: "_$PIECE(MDCONS,U,2))
- QUIT
- +16 IF +MDCONS>0
- KILL MDWP
- IF +$PIECE(MDCONS,U,3)
- Begin DoDot:1
- +17 SET MDWP(1405)=+$PIECE(MDCONS,U,3)_";GMR(123,"
- +18 DO UPDATE^TIUSRVP(.MDNOTE,+MDTI,.MDWP,1)
- +19 IF +MDNOTE<1
- DO LOGERR^MDCVT(MDNOD,"COULDN'T UPDATE THE NOTE")
- SET MDEFLG=1
- QUIT
- +20 IF +$PIECE(MDCONS,U,3)
- SET MDFDA(702,MDSTUD_",",.05)=+$PIECE(MDCONS,U,3)
- DO FILE^DIE("","MDFDA")
- +21 QUIT
- End DoDot:1
- if MDEFLG
- QUIT
- +22 ; Do imaging update and log response
- +23 if $$GET1^DIQ(702,MDSTUD_",",.09,"I")=3
- QUIT
- +24 ; Quit on Imaging error
- IF $ORDER(@MDGB@(2005,0))
- Begin DoDot:1
- +25 SET (MDIMG,MDX1)=0
- +26 FOR
- SET MDX1=$ORDER(@MDGB@(2005,MDX1))
- if 'MDX1
- QUIT
- Begin DoDot:2
- +27 SET MDIMG=+@MDGB@(2005,MDX1,0)
- +28 SET MDRET=$$CVTIMG(MDTT,MDNOD,MDTI,MDIMG)
- +29 if MDRET<0
- DO LOGERR^MDCVT(MDNOD,"Imaging error: "_$PIECE(MDRET,U,2))
- End DoDot:2
- if MDRET<0
- QUIT
- End DoDot:1
- if MDRET<0
- QUIT
- +30 if MDRET<0
- QUIT
- KILL MDFDA
- SET MDFDA(702,MDSTUD_",",.09)=3
- SET MDFDA(702,MDSTUD_",",.3)=MDNOD
- DO FILE^DIE("","MDFDA")
- WRITE "."
- +31 ;
- +32 ; Close the record with Administrative Closure
- +33 SET (MDR,MDR1)=""
- +34 IF +MDTI
- DO ADMNCLOS^TIUSRVPT(.MDR,+MDTI,"M",MDUSR)
- IF '+MDR
- DO DELETE^TIUSRVP(.MDR1,+MDTI)
- DO LOGERR^MDCVT(MDNOD,"Can't Administrative close document")
- +35 QUIT
- PROC(MDX5,MDX6) ; Get Medicine Procedure Name
- +1 NEW LL,LL6,LL8
- +2 IF MDX5="MCAR(699"
- SET LL=$PIECE($GET(^MCAR(699,MDX6,0)),U,12)
- if LL'>0
- QUIT
- SET LL=$PIECE($GET(^MCAR(697.2,+LL,0)),U)
- QUIT LL
- +3 IF MDX5="MCAR(699.5"
- Begin DoDot:1
- +4 SET LL6=$PIECE($GET(^MCAR(699.5,MDX6,0)),U,6)
- SET LL8=$PIECE($GET(^MCAR(699.5,MDX6,0)),U,8)
- +5 SET LL=$PIECE($GET(^MCAR(699.5,MDX6,0)),U,6)
- if 'LL
- QUIT
- SET LL=$PIECE($GET(^MCAR(697.2,LL,0)),U)
- QUIT LL
- End DoDot:1
- +6 IF MDX5[694
- SET LL=$PIECE($GET(^MCAR(694,MDX6,0)),U,3)
- if 'LL
- QUIT
- SET LL=$PIECE(^MCAR(697.2,LL,0),U)
- QUIT LL
- +7 SET LL=$ORDER(^MCAR(697.2,"C",MDX5,0))
- SET LL=$PIECE(^MCAR(697.2,LL,0),U,1)
- +8 QUIT LL
- CVTIMG(MDTST,MDN,MDTIU,MDIMAGES) ; Call Imaging API
- +1 QUIT $$TIU^MAGMC2CP(MDTST,MDN,MDTIU,.MDIMAGES)
- CVTCONS(MDTST,MDN,MDTIU) ; Call Consults API
- +1 QUIT $$MCCNVT^GMRCCP(MDTST,MDN,MDTIU)
- CHKINT(MDFL,MDMREC) ; Check to see if record from Medical Device
- +1 ; Returns 1 or 0
- +2 NEW MDN1,MDF
- +3 IF MDFL=691
- SET MDN1=$GET(^MCAR(691,+MDMREC,10,0))
- IF +$PIECE(MDN1,U,3)&($PIECE(MDN1,U,3)>1)
- QUIT 1
- +4 IF MDFL=691.1
- SET MDN1=$GET(^MCAR(691.1,+MDMREC,43,0))
- IF +$PIECE(MDN1,U,3)&($PIECE(MDN1,U,3)>1)
- QUIT 1
- +5 IF MDFL=691.5
- SET MDN1=$GET(^MCAR(691.5,+MDMREC,9,0))
- IF +$PIECE(MDN1,U,3)&($PIECE(MDN1,U,3)>1)
- QUIT 1
- +6 IF MDFL=691.6
- SET MDN1=$GET(^MCAR(691.6,+MDMREC,7,0))
- IF +$PIECE(MDN1,U,3)&($PIECE(MDN1,U,3)>1)
- QUIT 1
- +7 IF MDFL=691.8
- SET MDN1=$GET(^MCAR(691.8,+MDMREC,12,0))
- IF +$PIECE(MDN1,U,3)&($PIECE(MDN1,U,3)>1)
- QUIT 1
- +8 IF MDFL=698.3
- SET MDN1=$GET(^MCAR(698.3,+MDMREC,10,0))
- IF +$PIECE(MDN1,U,3)&($PIECE(MDN1,U,3)>1)
- QUIT 1
- +9 IF MDFL=699
- SET MDN1=$GET(^MCAR(699,+MDMREC,33,0))
- IF +$PIECE(MDN1,U,3)&($PIECE(MDN1,U,3)>1)
- QUIT 1
- +10 IF MDFL=700
- SET MDF=0
- Begin DoDot:1
- +11 SET MDN1=$GET(^MCAR(700,+MDMREC,25,0))
- +12 IF +$PIECE(MDN1,U,3)&($PIECE(MDN1,U,3)>1)
- SET MDF=1
- QUIT
- +13 SET MDN1=$GET(^MCAR(700,+MDMREC,3,0))
- +14 IF +$PIECE(MDN1,U,3)&($PIECE(MDN1,U,3)>1)
- SET MDF=1
- QUIT
- +15 SET MDN1=$GET(^MCAR(700,+MDMREC,4,0))
- +16 IF +$PIECE(MDN1,U,3)&($PIECE(MDN1,U,3)>1)
- SET MDF=1
- QUIT
- End DoDot:1
- if MDF
- QUIT 1
- +17 IF +$PIECE($GET(^MCAR(MDFL,+MDMREC,2005,0)),U,4)>0
- QUIT 1
- +18 QUIT 0
- BLD() ; Build the list of reports to convert
- +1 WRITE !
- KILL DIR
- SET DIR(0)="YA"
- SET DIR("A")="Build the list of reports to convert? "
- +2 SET DIR("A",1)="You can rebuild the list to check for new Medicine Reports that"
- +3 SET DIR("A",2)="may have been added since the last time you ran the Build Conversion List."
- SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +4 ;
- +5 ; User said no to re-build
- if Y<1
- QUIT 1
- +6 ; User has cancelled
- if $DATA(DIRUT)!$DATA(DIROUT)!(Y<1)
- QUIT 0
- +7 ;
- +8 KILL DIR
- SET DIR(0)="YA"
- SET DIR("A")="Queue the conversion list build? "
- SET DIR("B")="YES"
- DO ^DIR
- KILL DIR
- +9 ; User has opted to do it now
- IF Y=0
- DO QBLD
- QUIT 1
- +10 ; User has queued the build
- IF Y=1
- Begin DoDot:1
- +11 SET ZTRTN="QBLD^MDCVT1"
- +12 SET ZTDESC="Medicine Conversion List Build"
- +13 SET ZTREQ="@"
- SET ZTSAVE("ZTREQ")=""
- SET MDQUE=1
- SET MDDUZ=DUZ
- SET ZTSAVE("MDDUZ")=""
- SET ZTSAVE("MDQUE")=""
- +14 SET (ZTDTH,ZTIO)=""
- +15 DO ^%ZTLOAD
- +16 IF $GET(ZTSK)
- WRITE "Task Queued"
- +17 IF '$TEST
- WRITE "Task Cancelled"
- End DoDot:1
- QUIT 0
- +18 ; User cancelled out of the queueing
- QUIT 0
- +19 ;
- QBLD ; Queued entry point for re-build
- +1 LOCK +(^MDD(703.9,1,2)):5
- IF '$TEST
- QUIT
- +2 NEW MDGBL,MDPTR,MDFDA,MDFL,MDIEN,MDY,X2
- +3 SET X2=""
- FOR
- SET X2=$ORDER(^MDD(703.9,1,1,X2))
- if X2=""
- QUIT
- SET MDY=$GET(^(X2,0))
- Begin DoDot:1
- +4 if '+$PIECE(MDY,U,3)
- QUIT
- +5 SET MDFL=$PIECE(MDY,U)
- SET MDGBL="^MCAR("_MDFL_",""B"")"
- +6 FOR
- SET MDGBL=$QUERY(@MDGBL)
- if MDGBL=""
- QUIT
- if $QSUBSCRIPT(MDGBL,2)'="B"
- QUIT
- Begin DoDot:2
- +7 if '$PIECE($GET(^MCAR(MDFL,+$QSUBSCRIPT(MDGBL,4),0)),U,2)
- QUIT
- +8 SET MDPTR=$QSUBSCRIPT(MDGBL,4)_";MCAR("_MDFL_","
- +9 DO SYNC^MDCVT(MDPTR)
- End DoDot:2
- End DoDot:1
- +10 LOCK -(^MDD(703.9,1,2))
- +11 IF +$GET(MDQUE)
- Begin DoDot:1
- +12 NEW TXT,XMTO,XMBODY,XMDUZ,XMSUBJ
- +13 SET XMINSTR("FROM")=.5
- SET XMSUBJ="Conversion List"
- +14 SET XMTO=$GET(MDDUZ)
- if 'XMTO
- QUIT
- +15 SET TXT(1)="The Queued Conversion List is finished."
- +16 SET TXT(2)="You can run the Medicine report conversion process."
- SET XMBODY="TXT"
- +17 DO SENDMSG^XMXAPI(DUZ,XMSUBJ,XMBODY,XMTO,.XMINSTR)
- +18 KILL MDQUE,MDDUZ
- End DoDot:1
- +19 QUIT
- DELETE(MDIN) ; Delete study upon unsuccessful Note Creation
- +1 NEW MDFDA
- +2 SET MDFDA(702,MDIN_",",.01)=""
- +3 DO FILE^DIE("","MDFDA")
- +4 NEW DA,DIK
- SET DA=+MDIN
- SET DIK="^MDD(702,"
- DO ^DIK
- +5 QUIT
- TOTALS(MDSTAT) ; Count by Status
- +1 SET MDSTAT("E")=0
- +2 SET MDSTAT("E")=MDSTAT("TOT")-(MDSTAT("S")+MDSTAT("CR")+MDSTAT("CT"))
- +3 WRITE @IOF,!,"Conversion Totals",!,$TRANSLATE($JUSTIFY("",35)," ","-")
- +4 WRITE !,"Converted REAL Mode: ",$JUSTIFY(+$GET(MDSTAT("CR")),9)
- +5 WRITE !,"Converted TEST Mode: ",$JUSTIFY(+$GET(MDSTAT("CT")),9)
- +6 WRITE !,"Skipped: ",$JUSTIFY(+$GET(MDSTAT("S")),9)
- +7 WRITE !,"Error: ",$JUSTIFY(+$GET(MDSTAT("E")),9)
- +8 QUIT