MDAPI ; HOIFO/DP/NCA - CP API Calls ; [05-05-2003 10:28]
;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
; Description:
; These API's are for use by external packages communicating with CP.
;
; Integration Agreements:
; IA# 3378 [Subscription] Documents the APIs that external packages use to communicate with CP.
; IA# 3468 [Subscription] Use GMRCCP APIs.
;
EXTDATA(MDPROC) ; [Procedure]
; Returns 0/1 for external data needed
; Called by Consults to determine status of consult ordered
;
; Input parameters
; 1. MDPROC [Literal/Required] CP Definition IEN
;
Q:'$D(^MDS(702.01,+$G(MDPROC),0)) 0
I +$P(^MDS(702.01,+$G(MDPROC),0),U,3)!($O(^(.1,0))) Q 1
E Q 0
;
ISTAT(MDARR) ; [Procedure] Called by Imaging to update status
; Input parameters
; 1. MDARR [Literal/Required] Array from Imaging
;
; Input: MDARR(0)="0^error message" or "1^success message"
; MDARR(1)=TrackID (CP;Transaction IEN)
; MDARR(2)=Queue Number
; MDARR(3..N)=Warnings
N MDCON,MDCR,MDIEN,MDIENS,MDLP,MDSTAT,MDSTR,MDTIU,RESULTS
Q:$G(MDARR(0))=""
Q:$G(MDARR(1))=""
Q:$P(MDARR(1),";")'="CP"
Q:'(+$P(MDARR(1),";",2))
S MDIEN=+$P(MDARR(1),";",2),MDIENS=MDIEN_","
S MDSTAT=+$P(MDARR(0),"^")
S DATA("TRANSACTION")=MDIEN
; Is it in error?
I 'MDSTAT D Q
.D STATUS^MDRPCOT(MDIENS,2,$P(MDARR(0),"^",2))
.S DATA("PKG")="IMAGING"
.S DATA("MESSAGE")=$P(MDARR(0),"^",2) D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
.F MDLP=2:0 S MDLP=$O(MDARR(MDLP)) Q:'MDLP I $G(MDARR(MDLP))'="" D
..S DATA("MESSAGE")=$$TRANS(MDARR(MDLP)) D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
.D IMGSTAT^MDRPCOT1(+MDIENS,2) Q
; Call Consults that Partial Result ready
S MDCON=+$P(^MDD(702,MDIEN,0),"^",5),MDTIU=+$P(^(0),"^",6)
S MDCR=$$UPDCONS^MDRPCOT1(MDCON,MDTIU)
I +MDCR<0 D Q
.D STATUS^MDRPCOT(MDIENS,2,$P(MDCR,"^",2))
.S DATA("PKG")="CONSULTS",DATA("MESSAGE")=$P(MDCR,"^",2)
.D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
.Q
; Closeout the record
D STATUS^MDRPCOT(MDIENS,3,"")
; Update Images Status
D IMGSTAT^MDRPCOT1(+MDIENS,3)
Q
;
ITIU(RESULTS,DFN,CONSULT,VSTRING) ; [Procedure] API for Vista Imaging
; This API enables VistA Imaging to retrieve/create a TIU note for
; a consult for attaching images to.
;
; RESULTS(0) will equal one of the following
; IEN of the TIU note if successful
; or on failure one of the following status messages
; -1^No patient DFN
; -1^No Consult IEN
; -1^No VString
; -1^Error in CP transaction
; -1^Unable to create CP transaction
; -1^Unable to create the TIU document
; -1^No such consult for this patient.
;
; Input parameters
; 1. RESULTS [Reference/Required] Return array
; 2. DFN [Literal/Required] Patient IEN
; 3. CONSULT [Literal/Required] Consult IEN
; 4. VSTRING [Literal/Optional] VString data for TIU Note (Required to create new TIU note)
;
; Variables:
; MDIEN: [Private] Returns IEN from UPDATE~DIE call
; MDIENS: [Private] Scratch
; MDNOTE: [Private] Scratch
; MDTRANS: [Private] Contains IEN of CP transaction
;
; New private variables
NEW MDIEN,MDIENS,MDNOTE,MDTRANS
K ^TMP($J),^TMP("MDTIUST",$J)
N MDD,MDN,MDTIUER,MDTST,MDNEWV,MDTIUD S (MDTIUD,MDTIUER,MDTST)=""
I '$G(DFN) S RESULTS(0)="-1^No patient DFN" Q
I '$G(CONSULT) S RESULTS(0)="-1^No Consult IEN" Q
; Look for existing transaction
S MDTIUD=$$PREV^MDRPCOT(+CONSULT,"")
I +MDTIUD S RESULTS(0)=+MDTIUD Q
; No transaction, must create one for this consult
I $G(VSTRING)="" S RESULTS(0)="-1^No VString" Q
D CPLIST^GMRCCP(DFN,,$NA(^TMP($J)))
S MDX="" F S MDX=$O(^TMP($J,MDX)) Q:'MDX I $P(^(MDX),U,5)=CONSULT D Q
.D NOW^%DTC S MDD=%
.S:$L(VSTRING,";")=1 VSTRING=";"_VSTRING
.S MDNEWV=$$GETVSTR^MDRPCOT1(DFN,VSTRING,$P(^TMP($J,MDX),U,6),MDD)
.S MDFDA(702,"+1,",.01)=DFN
.S MDFDA(702,"+1,",.02)=MDD
.S MDFDA(702,"+1,",.03)=DUZ
.S MDFDA(702,"+1,",.04)=$P(^TMP($J,MDX),U,6)
.S MDFDA(702,"+1,",.05)=CONSULT
.S MDFDA(702,"+1,",.07)=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
.S MDFDA(702,"+1,",.09)=0
.;Create the new transaction
.D UPDATE^DIE("","MDFDA","MDIEN") I '$G(MDIEN(1)) D Q
..S RESULTS(0)="-1^Unable to create CP transaction"
.
.;Create the new TIU Note
.S MDIENS=MDIEN(1)_","
.S MDN=$$NEWTIUN^MDRPCOT(+MDIENS)
.S MDNOTE=$S(MDN:$$GET1^DIQ(702,+MDIENS,.06,"I"),1:0)
.I 'MDNOTE D Q
..N DA,DIK
..S RESULTS(0)="-1^Unable to create the TIU document"
..S DA=+MDIENS,DIK="^MDD(702," D ^DIK
.S RESULTS(0)=MDNOTE
Q
;
TIUCOMP(MDNOTE) ; [Procedure] Post Signature action to complete transaction
; Input parameters
; 1. MDNOTE [Literal/Required] TIU IEN
;
N MDFDA,MDRES
S MDRES=$O(^MDD(702,"ATIU",MDNOTE,0))
I $G(^MDD(702,+MDRES,0))="" Q 0
I $P($G(^MDD(702,+MDRES,0)),"^",9)=3 Q 1
S MDFDA(702,MDRES_",",.09)=3
D FILE^DIE("","MDFDA")
Q 1
;
TIUDEL(MDNOTE) ; [Procedure] TIU Note deletion Update
; Input parameters
; 1. MDNOTE [Literal/Required] TIU IEN
;
N MDGBL,MDRES,MDFDA,MDTRAN,RESULTS
S MDRES="" F S MDRES=$O(^MDD(702,"ATIU",MDNOTE,MDRES)) Q:'MDRES D
.Q:$G(^MDD(702,+MDRES,0))=""
.;S MDFDA(702,MDRES_",",.05)=""
.S MDFDA(702,MDRES_",",.06)=""
.D FILE^DIE("","MDFDA")
.S MDTRAN=$O(^MDD(702.001,"ASTUDY",MDRES,MDNOTE,0)) I +MDTRAN N DA,DIK S DA=+MDTRAN,DIK="^MDD(702.001," D ^DIK
.D STATUS^MDRPCOT(MDRES_",",2,"TIU note deleted.")
.S DATA("TRANSACTION")=MDRES,DATA("PKG")="TIU"
.S DATA("MESSAGE")="TIU note deleted." D RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
S MDGBL=$NA(^MDD(702.001,"PK",MDNOTE)) F S MDGBL=$Q(@MDGBL) Q:MDGBL="" Q:$QS(MDGBL,2)'="PK"!($QS(MDGBL,3)'=MDNOTE) S MDTRAN=$QS(MDGBL,6) N DA,DIK S DA=+MDTRAN,DIK="^MDD(702.001," D ^DIK
Q 1
;
TIUREAS(MDFN,MDOLDC,MDANOTE,MDNDFN,MDNEWC,MDNEWV,MDNTIU) ; [Function] This is an API to clean up and update TIU note re-assignment.
; Input parameters
; 1. MDFN [Literal/Required] The Patient DFN whose TIU document is being re-assigned.
; 2. MDOLDC [Literal/Required] The Consult that the note is being re-assigned from.
; 3. MDANOTE [Literal/Required] The TIU Document IEN that is being re-assigned.
; 4. MDNDFN [Literal/Required] The Patient DFN who will be re-assigned the TIU document.
; 5. MDNEWC [Literal/Required] The consult number that will be assignment the TIU document.
; 6. MDNEWV [Literal/Required] The new visit for the TIU document assignment.
; 7. MDNTIU [Literal/Required] The new reassigned TIU document IEN.
;
N MDD,MDGBL,MDTRAN,MDCHK,MDLP,MDMULN,MDN,MDPPR,MDREAS,MDTRANI,MDX
I '$G(MDFN) Q "0^No DFN for the TIU note re-assignment."
I '$G(MDOLDC) Q "0^No Old Consult # for the note re-assignment."
I '$G(MDANOTE) Q "0^No TIU Note IEN."
I '$G(MDNDFN) Q "0^No New DFN for the note assignment."
I '$G(MDNEWC) Q "0^No New Consult # for the note assignment."
I '$G(MDNTIU) Q "0^No New Reassigned TIU IEN."
S (MDD,MDCHK,MDREAS,MDTRAN)="",MDPPR=0 K ^TMP("MDTMP",$J)
S MDTRAN=$O(^MDD(702,"ATIU",MDANOTE,0)) I +MDTRAN S MDCHK=$G(^MDD(702,MDTRAN,0)),MDTRANI=MDTRAN_"," D
.I $P(MDCHK,U,5)=MDOLDC&($P(MDCHK,U,6)=MDANOTE) D
..S MDFDA(702,+MDTRAN_",",.06)=""
..D FILE^DIE("","MDFDA") K MDFDA
S MDGBL=$NA(^MDD(702.001,"PK",MDANOTE))
F S MDGBL=$Q(@MDGBL) Q:MDGBL="" Q:$QS(MDGBL,2)'="PK"!($QS(MDGBL,3)'=MDANOTE) S MDN=$QS(MDGBL,6) N DA,DIK S DA=+MDN,DIK="^MDD(702.001," D ^DIK
S MDMULN=+$O(^MDD(702.001,"ASTUDY",+MDTRAN,0))
I '+MDMULN I +MDTRAN N DA,DIK S DA=+MDTRAN,DIK="^MDD(702," D ^DIK
D NOW^%DTC S MDD=% S MDTRANI=$O(^MDD(702,"ACON",MDNEWC,0))
S MDREAS=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
I +MDTRANI&(MDNDFN=+$G(^MDD(702,+MDTRANI,0))) D
.S MDPPR=$P($G(^MDD(702,+MDTRANI,0)),"^",4) Q:'MDPPR
.S MDNEWV=$$GETVSTR^MDRPCOT1(MDNDFN,MDREAS,MDPPR,MDD)
.S MDFDA(702,+MDTRANI_",",.06)=MDNTIU
.S MDFDA(702,"+1,",.07)=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
.D FILE^DIE("","MDFDA") K MDFDA
I 'MDPPR D
.D CPLIST^GMRCCP(MDNDFN,,$NA(^TMP("MDTMP",$J)))
.S MDX=""
.F S MDX=$O(^TMP("MDTMP",$J,MDX)) Q:'MDX S:$P(^(MDX),U,5)=MDNEWC MDPPR=$P(^(MDX),U,6)
K ^TMP("MDTMP",$J)
I +MDPPR Q 1
S MDNEWV=$$GETVSTR^MDRPCOT1(MDNDFN,MDREAS,MDPPR,MDD)
S MDFDA(702,"+1,",.01)=MDNDFN
S MDFDA(702,"+1,",.02)=MDD
S MDFDA(702,"+1,",.03)=DUZ
S MDFDA(702,"+1,",.04)=MDPPR
S MDFDA(702,"+1,",.05)=MDNEWC
S MDFDA(702,"+1,",.06)=MDNTIU
S MDFDA(702,"+1,",.07)=$P(MDNEWV,";",3)_";"_$P(MDNEWV,";",2)_";"_$P(MDNEWV,";")
S MDFDA(702,"+1,",.09)=0
D UPDATE^DIE("","MDFDA")
Q 1
;
TRANS(STR) ; [Function] Translate the upper arrows to blanks
; Input parameters
; 1. STR [Literal/Required] Input: Text with upper arrows that needs to be removed
;
I STR["^" Q $TR(STR,"^"," ")
Q STR
;
GETCP(RESULTS,MDCSLT) ; API to return CP Study data
; Input Parameters:
; 1. RESULTS [Literal/Required] Return Array
; 2. MDCSLT [Literal/Required] Consult number
;
; Output:
; RESULTS(0)=-1^Error Message or 1 for success
; (N,1)=CP Study Number
; (N,2)=Patient DFN
; (N,3)=Created Date/Time
; (N,4)=Created By
; (N,5)=CP Definition (External Name)
; (N,6)=Consult Number
; (N,7)=TIU Note IEN
; (N,8)=VSTR
; (N,9)=Transaction Status
;
; Where N = 1..n entries
;
N MDCT,MDX,MDY
I '$G(MDCSLT) S @RESULTS@(0)="-1^No Consult Number passed" Q
S MDX=$O(^MDD(702,"ACON",MDCSLT,0)) I 'MDX S @RESULTS@(0)="-1^No CP Study Entry." Q
S @RESULTS@(0)=1
S MDCT=0,MDX="" F S MDX=$O(^MDD(702,"ACON",MDCSLT,MDX)) Q:MDX<1 D
.S MDCT=MDCT+1,@RESULTS@(MDCT,1)=MDX
.S MDY=$G(^MDD(702,+MDX,0)),@RESULTS@(MDCT,2)=$P(MDY,U),@RESULTS@(MDCT,3)=$P(MDY,U,2),@RESULTS@(MDCT,4)=$P(MDY,U,3),@RESULTS@(MDCT,5)=$$GET1^DIQ(702,+MDX,.04,"E")
.S @RESULTS@(MDCT,6)=$P(MDY,U,5),@RESULTS@(MDCT,7)=$P(MDY,U,6),@RESULTS@(MDCT,8)=$P(MDY,U,7),@RESULTS@(MDCT,9)=$$GET1^DIQ(702,+MDX,.09,"E")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDAPI 9945 printed Dec 13, 2024@01:42:08 Page 2
MDAPI ; HOIFO/DP/NCA - CP API Calls ; [05-05-2003 10:28]
+1 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
+2 ; Description:
+3 ; These API's are for use by external packages communicating with CP.
+4 ;
+5 ; Integration Agreements:
+6 ; IA# 3378 [Subscription] Documents the APIs that external packages use to communicate with CP.
+7 ; IA# 3468 [Subscription] Use GMRCCP APIs.
+8 ;
EXTDATA(MDPROC) ; [Procedure]
+1 ; Returns 0/1 for external data needed
+2 ; Called by Consults to determine status of consult ordered
+3 ;
+4 ; Input parameters
+5 ; 1. MDPROC [Literal/Required] CP Definition IEN
+6 ;
+7 if '$DATA(^MDS(702.01,+$GET(MDPROC),0))
QUIT 0
+8 IF +$PIECE(^MDS(702.01,+$GET(MDPROC),0),U,3)!($ORDER(^(.1,0)))
QUIT 1
+9 IF '$TEST
QUIT 0
+10 ;
ISTAT(MDARR) ; [Procedure] Called by Imaging to update status
+1 ; Input parameters
+2 ; 1. MDARR [Literal/Required] Array from Imaging
+3 ;
+4 ; Input: MDARR(0)="0^error message" or "1^success message"
+5 ; MDARR(1)=TrackID (CP;Transaction IEN)
+6 ; MDARR(2)=Queue Number
+7 ; MDARR(3..N)=Warnings
+8 NEW MDCON,MDCR,MDIEN,MDIENS,MDLP,MDSTAT,MDSTR,MDTIU,RESULTS
+9 if $GET(MDARR(0))=""
QUIT
+10 if $GET(MDARR(1))=""
QUIT
+11 if $PIECE(MDARR(1),";")'="CP"
QUIT
+12 if '(+$PIECE(MDARR(1),";",2))
QUIT
+13 SET MDIEN=+$PIECE(MDARR(1),";",2)
SET MDIENS=MDIEN_","
+14 SET MDSTAT=+$PIECE(MDARR(0),"^")
+15 SET DATA("TRANSACTION")=MDIEN
+16 ; Is it in error?
+17 IF 'MDSTAT
Begin DoDot:1
+18 DO STATUS^MDRPCOT(MDIENS,2,$PIECE(MDARR(0),"^",2))
+19 SET DATA("PKG")="IMAGING"
+20 SET DATA("MESSAGE")=$PIECE(MDARR(0),"^",2)
DO RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
+21 FOR MDLP=2:0
SET MDLP=$ORDER(MDARR(MDLP))
if 'MDLP
QUIT
IF $GET(MDARR(MDLP))'=""
Begin DoDot:2
+22 SET DATA("MESSAGE")=$$TRANS(MDARR(MDLP))
DO RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
End DoDot:2
+23 DO IMGSTAT^MDRPCOT1(+MDIENS,2)
QUIT
End DoDot:1
QUIT
+24 ; Call Consults that Partial Result ready
+25 SET MDCON=+$PIECE(^MDD(702,MDIEN,0),"^",5)
SET MDTIU=+$PIECE(^(0),"^",6)
+26 SET MDCR=$$UPDCONS^MDRPCOT1(MDCON,MDTIU)
+27 IF +MDCR<0
Begin DoDot:1
+28 DO STATUS^MDRPCOT(MDIENS,2,$PIECE(MDCR,"^",2))
+29 SET DATA("PKG")="CONSULTS"
SET DATA("MESSAGE")=$PIECE(MDCR,"^",2)
+30 DO RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
+31 QUIT
End DoDot:1
QUIT
+32 ; Closeout the record
+33 DO STATUS^MDRPCOT(MDIENS,3,"")
+34 ; Update Images Status
+35 DO IMGSTAT^MDRPCOT1(+MDIENS,3)
+36 QUIT
+37 ;
ITIU(RESULTS,DFN,CONSULT,VSTRING) ; [Procedure] API for Vista Imaging
+1 ; This API enables VistA Imaging to retrieve/create a TIU note for
+2 ; a consult for attaching images to.
+3 ;
+4 ; RESULTS(0) will equal one of the following
+5 ; IEN of the TIU note if successful
+6 ; or on failure one of the following status messages
+7 ; -1^No patient DFN
+8 ; -1^No Consult IEN
+9 ; -1^No VString
+10 ; -1^Error in CP transaction
+11 ; -1^Unable to create CP transaction
+12 ; -1^Unable to create the TIU document
+13 ; -1^No such consult for this patient.
+14 ;
+15 ; Input parameters
+16 ; 1. RESULTS [Reference/Required] Return array
+17 ; 2. DFN [Literal/Required] Patient IEN
+18 ; 3. CONSULT [Literal/Required] Consult IEN
+19 ; 4. VSTRING [Literal/Optional] VString data for TIU Note (Required to create new TIU note)
+20 ;
+21 ; Variables:
+22 ; MDIEN: [Private] Returns IEN from UPDATE~DIE call
+23 ; MDIENS: [Private] Scratch
+24 ; MDNOTE: [Private] Scratch
+25 ; MDTRANS: [Private] Contains IEN of CP transaction
+26 ;
+27 ; New private variables
+28 NEW MDIEN,MDIENS,MDNOTE,MDTRANS
+29 KILL ^TMP($JOB),^TMP("MDTIUST",$JOB)
+30 NEW MDD,MDN,MDTIUER,MDTST,MDNEWV,MDTIUD
SET (MDTIUD,MDTIUER,MDTST)=""
+31 IF '$GET(DFN)
SET RESULTS(0)="-1^No patient DFN"
QUIT
+32 IF '$GET(CONSULT)
SET RESULTS(0)="-1^No Consult IEN"
QUIT
+33 ; Look for existing transaction
+34 SET MDTIUD=$$PREV^MDRPCOT(+CONSULT,"")
+35 IF +MDTIUD
SET RESULTS(0)=+MDTIUD
QUIT
+36 ; No transaction, must create one for this consult
+37 IF $GET(VSTRING)=""
SET RESULTS(0)="-1^No VString"
QUIT
+38 DO CPLIST^GMRCCP(DFN,,$NAME(^TMP($JOB)))
+39 SET MDX=""
FOR
SET MDX=$ORDER(^TMP($JOB,MDX))
if 'MDX
QUIT
IF $PIECE(^(MDX),U,5)=CONSULT
Begin DoDot:1
+40 DO NOW^%DTC
SET MDD=%
+41 if $LENGTH(VSTRING,";")=1
SET VSTRING=";"_VSTRING
+42 SET MDNEWV=$$GETVSTR^MDRPCOT1(DFN,VSTRING,$PIECE(^TMP($JOB,MDX),U,6),MDD)
+43 SET MDFDA(702,"+1,",.01)=DFN
+44 SET MDFDA(702,"+1,",.02)=MDD
+45 SET MDFDA(702,"+1,",.03)=DUZ
+46 SET MDFDA(702,"+1,",.04)=$PIECE(^TMP($JOB,MDX),U,6)
+47 SET MDFDA(702,"+1,",.05)=CONSULT
+48 SET MDFDA(702,"+1,",.07)=$PIECE(MDNEWV,";",3)_";"_$PIECE(MDNEWV,";",2)_";"_$PIECE(MDNEWV,";")
+49 SET MDFDA(702,"+1,",.09)=0
+50 ;Create the new transaction
+51 DO UPDATE^DIE("","MDFDA","MDIEN")
IF '$GET(MDIEN(1))
Begin DoDot:2
+52 SET RESULTS(0)="-1^Unable to create CP transaction"
End DoDot:2
QUIT
+53 +54 ;Create the new TIU Note
+55 SET MDIENS=MDIEN(1)_","
+56 SET MDN=$$NEWTIUN^MDRPCOT(+MDIENS)
+57 SET MDNOTE=$SELECT(MDN:$$GET1^DIQ(702,+MDIENS,.06,"I"),1:0)
+58 IF 'MDNOTE
Begin DoDot:2
+59 NEW DA,DIK
+60 SET RESULTS(0)="-1^Unable to create the TIU document"
+61 SET DA=+MDIENS
SET DIK="^MDD(702,"
DO ^DIK
End DoDot:2
QUIT
+62 SET RESULTS(0)=MDNOTE
End DoDot:1
QUIT
+63 QUIT
+64 ;
TIUCOMP(MDNOTE) ; [Procedure] Post Signature action to complete transaction
+1 ; Input parameters
+2 ; 1. MDNOTE [Literal/Required] TIU IEN
+3 ;
+4 NEW MDFDA,MDRES
+5 SET MDRES=$ORDER(^MDD(702,"ATIU",MDNOTE,0))
+6 IF $GET(^MDD(702,+MDRES,0))=""
QUIT 0
+7 IF $PIECE($GET(^MDD(702,+MDRES,0)),"^",9)=3
QUIT 1
+8 SET MDFDA(702,MDRES_",",.09)=3
+9 DO FILE^DIE("","MDFDA")
+10 QUIT 1
+11 ;
TIUDEL(MDNOTE) ; [Procedure] TIU Note deletion Update
+1 ; Input parameters
+2 ; 1. MDNOTE [Literal/Required] TIU IEN
+3 ;
+4 NEW MDGBL,MDRES,MDFDA,MDTRAN,RESULTS
+5 SET MDRES=""
FOR
SET MDRES=$ORDER(^MDD(702,"ATIU",MDNOTE,MDRES))
if 'MDRES
QUIT
Begin DoDot:1
+6 if $GET(^MDD(702,+MDRES,0))=""
QUIT
+7 ;S MDFDA(702,MDRES_",",.05)=""
+8 SET MDFDA(702,MDRES_",",.06)=""
+9 DO FILE^DIE("","MDFDA")
+10 SET MDTRAN=$ORDER(^MDD(702.001,"ASTUDY",MDRES,MDNOTE,0))
IF +MDTRAN
NEW DA,DIK
SET DA=+MDTRAN
SET DIK="^MDD(702.001,"
DO ^DIK
+11 DO STATUS^MDRPCOT(MDRES_",",2,"TIU note deleted.")
+12 SET DATA("TRANSACTION")=MDRES
SET DATA("PKG")="TIU"
+13 SET DATA("MESSAGE")="TIU note deleted."
DO RPC^MDRPCOT(.RESULTS,"ADDMSG",.DATA)
End DoDot:1
+14 SET MDGBL=$NAME(^MDD(702.001,"PK",MDNOTE))
FOR
SET MDGBL=$QUERY(@MDGBL)
if MDGBL=""
QUIT
if $QSUBSCRIPT(MDGBL,2)'="PK"!($QSUBSCRIPT(MDGBL,3)'=MDNOTE)
QUIT
SET MDTRAN=$QSUBSCRIPT(MDGBL,6)
NEW DA,DIK
SET DA=+MDTRAN
SET DIK="^MDD(702.001,"
DO ^DIK
+15 QUIT 1
+16 ;
TIUREAS(MDFN,MDOLDC,MDANOTE,MDNDFN,MDNEWC,MDNEWV,MDNTIU) ; [Function] This is an API to clean up and update TIU note re-assignment.
+1 ; Input parameters
+2 ; 1. MDFN [Literal/Required] The Patient DFN whose TIU document is being re-assigned.
+3 ; 2. MDOLDC [Literal/Required] The Consult that the note is being re-assigned from.
+4 ; 3. MDANOTE [Literal/Required] The TIU Document IEN that is being re-assigned.
+5 ; 4. MDNDFN [Literal/Required] The Patient DFN who will be re-assigned the TIU document.
+6 ; 5. MDNEWC [Literal/Required] The consult number that will be assignment the TIU document.
+7 ; 6. MDNEWV [Literal/Required] The new visit for the TIU document assignment.
+8 ; 7. MDNTIU [Literal/Required] The new reassigned TIU document IEN.
+9 ;
+10 NEW MDD,MDGBL,MDTRAN,MDCHK,MDLP,MDMULN,MDN,MDPPR,MDREAS,MDTRANI,MDX
+11 IF '$GET(MDFN)
QUIT "0^No DFN for the TIU note re-assignment."
+12 IF '$GET(MDOLDC)
QUIT "0^No Old Consult # for the note re-assignment."
+13 IF '$GET(MDANOTE)
QUIT "0^No TIU Note IEN."
+14 IF '$GET(MDNDFN)
QUIT "0^No New DFN for the note assignment."
+15 IF '$GET(MDNEWC)
QUIT "0^No New Consult # for the note assignment."
+16 IF '$GET(MDNTIU)
QUIT "0^No New Reassigned TIU IEN."
+17 SET (MDD,MDCHK,MDREAS,MDTRAN)=""
SET MDPPR=0
KILL ^TMP("MDTMP",$JOB)
+18 SET MDTRAN=$ORDER(^MDD(702,"ATIU",MDANOTE,0))
IF +MDTRAN
SET MDCHK=$GET(^MDD(702,MDTRAN,0))
SET MDTRANI=MDTRAN_","
Begin DoDot:1
+19 IF $PIECE(MDCHK,U,5)=MDOLDC&($PIECE(MDCHK,U,6)=MDANOTE)
Begin DoDot:2
+20 SET MDFDA(702,+MDTRAN_",",.06)=""
+21 DO FILE^DIE("","MDFDA")
KILL MDFDA
End DoDot:2
End DoDot:1
+22 SET MDGBL=$NAME(^MDD(702.001,"PK",MDANOTE))
+23 FOR
SET MDGBL=$QUERY(@MDGBL)
if MDGBL=""
QUIT
if $QSUBSCRIPT(MDGBL,2)'="PK"!($QSUBSCRIPT(MDGBL,3)'=MDANOTE)
QUIT
SET MDN=$QSUBSCRIPT(MDGBL,6)
NEW DA,DIK
SET DA=+MDN
SET DIK="^MDD(702.001,"
DO ^DIK
+24 SET MDMULN=+$ORDER(^MDD(702.001,"ASTUDY",+MDTRAN,0))
+25 IF '+MDMULN
IF +MDTRAN
NEW DA,DIK
SET DA=+MDTRAN
SET DIK="^MDD(702,"
DO ^DIK
+26 DO NOW^%DTC
SET MDD=%
SET MDTRANI=$ORDER(^MDD(702,"ACON",MDNEWC,0))
+27 SET MDREAS=$PIECE(MDNEWV,";",3)_";"_$PIECE(MDNEWV,";",2)_";"_$PIECE(MDNEWV,";")
+28 IF +MDTRANI&(MDNDFN=+$GET(^MDD(702,+MDTRANI,0)))
Begin DoDot:1
+29 SET MDPPR=$PIECE($GET(^MDD(702,+MDTRANI,0)),"^",4)
if 'MDPPR
QUIT
+30 SET MDNEWV=$$GETVSTR^MDRPCOT1(MDNDFN,MDREAS,MDPPR,MDD)
+31 SET MDFDA(702,+MDTRANI_",",.06)=MDNTIU
+32 SET MDFDA(702,"+1,",.07)=$PIECE(MDNEWV,";",3)_";"_$PIECE(MDNEWV,";",2)_";"_$PIECE(MDNEWV,";")
+33 DO FILE^DIE("","MDFDA")
KILL MDFDA
End DoDot:1
+34 IF 'MDPPR
Begin DoDot:1
+35 DO CPLIST^GMRCCP(MDNDFN,,$NAME(^TMP("MDTMP",$JOB)))
+36 SET MDX=""
+37 FOR
SET MDX=$ORDER(^TMP("MDTMP",$JOB,MDX))
if 'MDX
QUIT
if $PIECE(^(MDX),U,5)=MDNEWC
SET MDPPR=$PIECE(^(MDX),U,6)
End DoDot:1
+38 KILL ^TMP("MDTMP",$JOB)
+39 IF +MDPPR
QUIT 1
+40 SET MDNEWV=$$GETVSTR^MDRPCOT1(MDNDFN,MDREAS,MDPPR,MDD)
+41 SET MDFDA(702,"+1,",.01)=MDNDFN
+42 SET MDFDA(702,"+1,",.02)=MDD
+43 SET MDFDA(702,"+1,",.03)=DUZ
+44 SET MDFDA(702,"+1,",.04)=MDPPR
+45 SET MDFDA(702,"+1,",.05)=MDNEWC
+46 SET MDFDA(702,"+1,",.06)=MDNTIU
+47 SET MDFDA(702,"+1,",.07)=$PIECE(MDNEWV,";",3)_";"_$PIECE(MDNEWV,";",2)_";"_$PIECE(MDNEWV,";")
+48 SET MDFDA(702,"+1,",.09)=0
+49 DO UPDATE^DIE("","MDFDA")
+50 QUIT 1
+51 ;
TRANS(STR) ; [Function] Translate the upper arrows to blanks
+1 ; Input parameters
+2 ; 1. STR [Literal/Required] Input: Text with upper arrows that needs to be removed
+3 ;
+4 IF STR["^"
QUIT $TRANSLATE(STR,"^"," ")
+5 QUIT STR
+6 ;
GETCP(RESULTS,MDCSLT) ; API to return CP Study data
+1 ; Input Parameters:
+2 ; 1. RESULTS [Literal/Required] Return Array
+3 ; 2. MDCSLT [Literal/Required] Consult number
+4 ;
+5 ; Output:
+6 ; RESULTS(0)=-1^Error Message or 1 for success
+7 ; (N,1)=CP Study Number
+8 ; (N,2)=Patient DFN
+9 ; (N,3)=Created Date/Time
+10 ; (N,4)=Created By
+11 ; (N,5)=CP Definition (External Name)
+12 ; (N,6)=Consult Number
+13 ; (N,7)=TIU Note IEN
+14 ; (N,8)=VSTR
+15 ; (N,9)=Transaction Status
+16 ;
+17 ; Where N = 1..n entries
+18 ;
+19 NEW MDCT,MDX,MDY
+20 IF '$GET(MDCSLT)
SET @RESULTS@(0)="-1^No Consult Number passed"
QUIT
+21 SET MDX=$ORDER(^MDD(702,"ACON",MDCSLT,0))
IF 'MDX
SET @RESULTS@(0)="-1^No CP Study Entry."
QUIT
+22 SET @RESULTS@(0)=1
+23 SET MDCT=0
SET MDX=""
FOR
SET MDX=$ORDER(^MDD(702,"ACON",MDCSLT,MDX))
if MDX<1
QUIT
Begin DoDot:1
+24 SET MDCT=MDCT+1
SET @RESULTS@(MDCT,1)=MDX
+25 SET MDY=$GET(^MDD(702,+MDX,0))
SET @RESULTS@(MDCT,2)=$PIECE(MDY,U)
SET @RESULTS@(MDCT,3)=$PIECE(MDY,U,2)
SET @RESULTS@(MDCT,4)=$PIECE(MDY,U,3)
SET @RESULTS@(MDCT,5)=$$GET1^DIQ(702,+MDX,.04,"E")
+26 SET @RESULTS@(MDCT,6)=$PIECE(MDY,U,5)
SET @RESULTS@(MDCT,7)=$PIECE(MDY,U,6)
SET @RESULTS@(MDCT,8)=$PIECE(MDY,U,7)
SET @RESULTS@(MDCT,9)=$$GET1^DIQ(702,+MDX,.09,"E")
End DoDot:1
+27 QUIT
