MDRPCOTH ; HOIFO/NCA - Process High Volume Procedure Results ;2/1/12 16:39
;;1.0;CLINICAL PROCEDURES;**21,24**;Apr 01, 2004;Build 8
; Integration Agreements:
; IA# 2263 [Supported] Calls to XPAR.
; IA# 3468 [Subscription] GMRCCP API.
; IA# 3535 [Subscription] Calls to TIUSRVP.
; IA# 4508 [Subscription] Call to TIUSRVPT.
; IA# 10060 [Supported] Access to NEW PERSON file (#200).
; IA# 10104 [Supported] Routine XLFSTR calls
;
ADDMSG ; [Procedure] Add message to transaction
N MDIEN,MDIENS,MDRET
Q:'$G(DATA("TRANSACTION"))
Q:$G(DATA("MESSAGE"))=""
S MDIEN=+DATA("TRANSACTION"),MDIENS="+1,"_MDIEN_","
D NOW^%DTC S DATA("DATE")=% K %
S MDFDA(702.091,MDIENS,.01)=+$O(^MDD(702,+MDIEN,.091,"A"),-1)+1
S MDFDA(702.091,MDIENS,.02)=DATA("DATE")
S MDFDA(702.091,MDIENS,.03)=$G(DATA("PKG"),"UNKNOWN")
S MDFDA(702.091,MDIENS,.09)=DATA("MESSAGE")
D UPDATE^DIE("","MDFDA","MDRET")
Q
FILEMSG(STUDY,MDPKG,MDSTAT,MDMSG) ; [Procedure] File Study Status and Message.
N DATA
S DATA("TRANSACTION")=STUDY,DATA("PKG")=MDPKG
S DATA("MESSAGE")=$P(MDMSG,"^",2)
D STATUS(STUDY_",",MDSTAT,$P(MDMSG,"^",2)),ADDMSG
Q
;
NEWSTAT ; [Procedure] RPC Call to set status
S MDFDA(702,DATA,.09)=TYPE
D FILE^DIE("","MDFDA")
I TYPE=3&($G(^MDK(704.202,+DATA,0))'="") K MDFDA S MDFDA(704.202,DATA,.09)=0 D FILE^DIE("","MDFDA") K MDFDA
Q
;
STATUS(MDIENS,MDSTAT,MDMSG) ; [Procedure] Update transaction status
S MDFDA(702,MDIENS,.08)=$G(MDMSG)
S MDFDA(702,MDIENS,.09)=MDSTAT
D FILE^DIE("","MDFDA")
Q
;
NEWTIUN(STUDY,RECID) ; [Function] Create a new TIU for transaction
; Input: STUDY - IENS of CP study entry
; Return: TIU Document IEN
N CTR,DFN,MDADD,MDCON,MDCONRS,MDCT,MDDAR,MDFDA,MDGST,MDL,MDLOC,MDNOTE,MDPDT,MDPROC,MDRESU,MDTI,MDTCHK,MDTITL,MDTRE,MDTSTR,MDNVST,MDVST,MDVSTR,MDWPA,MDPT,MDR,MDRP,MDRST,MDTX,MDUSR
N MDHLS,MDHLS1,MDKK,MDFLST,MDLC,MDLL,MDX0 S MDLC=0
S CTR=0,MDGST=+STUDY,MDRESU=""
K ^TMP("MDDAR",$J) N MDDAR2,GLOARR,MDMUS S MDMUS=0
; Get data for TIU Note Creation
S (MDTSTR,MDRESU)=$$GETDATA^MDRPCOT(MDGST)
; File Error message
I +MDRESU<0 D FILEMSG(MDGST,"CP",2,MDRESU) Q MDRESU
I $G(MDTSTR)="" Q "-1^No Data to Create TIU Document"
F MDL="DFN","MDTITL","MDLOC","MDNOTE","MDCON","MDPROC","MDVSTR","MDNVST" D
.S CTR=CTR+1,@MDL=$P(MDTSTR,"^",CTR)
S MDVST=""
; If previous TIU document exists, quit
I MDNOTE Q MDNOTE
I 'MDLOC Q "-1^No Hospital Location."
S MDUSR=$$FIND1^DIC(200,,"X","CLINICAL,DEVICE PROXY SERVICE","B")
; Create new visit, if no vstring
S MDPDT=$$PDT^MDRPCOT1(MDGST)
I 'MDPDT S MDPT=$O(^MDD(703.1,"ASTUDYID",+MDGST,""),-1),MDPDT=$P($G(^MDD(703.1,+MDPT,0)),U,3)
S:'MDPDT MDPDT=$P(MDVSTR,";",2) ; If No D/T Performed grab visit D/T
I $P(MDVSTR,";",3)="V" S $P(MDVSTR,";",3)="A"
; Build variables for TIU Call
S MDWPA(.05)=1 ; Undicated Status
S MDWPA(1405)=+MDCON_";GMR(123," ; Package Reference
S MDWPA(70201)=5 ; Default Procedure Summary Code "Machine Resulted"
I MDPDT S MDWPA(70202)=MDPDT ; Date/Time Performed
; File PCE Error message
S MDDAR=$NA(^TMP("MDDAR",$J)),MDDAR2=$NA(GLOARR)
;S MDRP=0 F S MDRP=$O(^MDD(702,+MDGST,.1,MDRP)) Q:'MDRP D
;.S MDRST=$P($G(^MDD(702,MDGST,.1,0)),"^",3)
I +RECID D CICNV^MDHL7U3(+RECID,.MDDAR) D SETGLO^MDRPCW1(.MDDAR,.MDDAR2)
K ^TMP("MDDAR",$J)
I +$G(@MDDAR2@("POV",0))>0 F MDLL=1:1:+$G(@MDDAR2@("POV",0)) S MDLC=MDLC+1,MDFLST(MDLC)=$G(@MDDAR2@("POV",MDLL))
I +$G(@MDDAR2@("CPT",0))>0 F MDLL=1:1:+$G(@MDDAR2@("CPT",0)) S MDLC=MDLC+1,MDFLST(MDLC)=$G(@MDDAR2@("CPT",MDLL))
S MDRESU=$$EN1^MDPCE2(.MDFLST,MDGST,$P(MDVSTR,";",2),MDPROC,$P(MDVSTR,";",3),"P",MDLOC) I +MDRESU S MDVST=+MDRESU
I MDNVST&(+MDRESU<0) D FILEMSG(MDGST,"PCE",2,$P(MDRESU,"^",2)) Q MDRESU
; Create the TIU note stub
S MDNOTE="" D MAKE^TIUSRVP(.MDNOTE,DFN,MDTITL,$P(MDVSTR,";",2),MDLOC,$S(MDVST:MDVST,1:""),.MDWPA,MDVSTR,1,1)
I '(+MDNOTE) S $P(MDNOTE,"^")=-1 Q MDNOTE
; Finalize the transaction
S MDFDA(702,STUDY_",",.06)=+MDNOTE
S MDFDA(702,STUDY_",",.08)=""
S:MDVST>0 MDFDA(702,STUDY_",",.13)=MDVST
D FILE^DIE("","MDFDA")
D UPD^MDKUTLR(STUDY,+MDNOTE)
S:$$UP^XLFSTR($$GET1^DIQ(702,+STUDY_",",".11","E"))["MUSE" MDMUS=1
S MDHLS=$P(^MDS(702.01,+$P(^MDD(702,+STUDY,0),"^",4),0),"^")
S MDHLS1=$$GET^XPAR("SYS","MD GET HIGH VOLUME",MDHLS,"E")
K MDHLS,MDWPA D GETTXT^MDAR7M(.MDWPA,RECID)
I $G(MDWPA("TEXT",1,0))="" Q 1
I $G(MDWPA("TEXT",0))["AMENDMENT" D
.D NOW^%DTC K MDFDA
.S MDFDA(702.091,"+1,"_STUDY_",",.01)=+$O(^MDD(702,+STUDY,.091,"A"),-1)+1
.S MDFDA(702.091,"+1,"_STUDY_",",.02)=% K %
.S MDFDA(702.091,"+1,"_STUDY_",",.03)="CLINICAL PROCEDURES"
.S MDFDA(702.091,"+1,"_STUDY_",",.09)="AMENDMENT"
.D UPDATE^DIE("","MDFDA")
I $G(MDWPA(1202))=""&('+$P(MDHLS1,";",2)) S MDWPA(1202)=MDUSR,MDWPA(1204)=MDUSR,MDWPA(1302)=MDUSR
S MDWPA(.05)=5,MDTI=""
I +$P(MDHLS1,";",2)&('+$$GET^XPAR("SYS","MD USE NOTE",1)) N MDADAR,MDCCN S MDCCN=0 D Q 1
.S MDCT=0 F S MDCT=$O(MDWPA("TEXT",MDCT)) Q:MDCT<1 S MDADAR=$G(MDWPA("TEXT",MDCT,0)) D
..Q:'$G(RECID)
..S ^MDD(703.1,+RECID,.4,MDCT,0)=MDADAR,MDCCN=MDCCN+1
..Q
.S ^MDD(703.1,+RECID,.4,0)="^^"_MDCCN_"^"_MDCCN_"^"_DT_"^"
.K MDWPA Q
D UPDATE^TIUSRVP(.MDTI,+MDNOTE,.MDWPA,1)
;I +$$GET^XPAR("SYS","MD NOT ADMN CLOSE MUSE NOTE",1) S MDCONRS=$$CPDOC^GMRCCP(+MDCON,+MDNOTE,2) Q 1
I +$P(MDHLS1,";",2)&(+$$GET^XPAR("SYS","MD USE NOTE",1)) S MDCONRS=$$CPDOC^GMRCCP(+MDCON,+MDNOTE,2) Q 1
I +MDNOTE&MDTI'<1 D ADMNCLOS^TIUSRVPT(.MDR,+MDNOTE,"M",MDWPA(1202))
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDRPCOTH 5505 printed Dec 13, 2024@01:44:10 Page 2
MDRPCOTH ; HOIFO/NCA - Process High Volume Procedure Results ;2/1/12 16:39
+1 ;;1.0;CLINICAL PROCEDURES;**21,24**;Apr 01, 2004;Build 8
+2 ; Integration Agreements:
+3 ; IA# 2263 [Supported] Calls to XPAR.
+4 ; IA# 3468 [Subscription] GMRCCP API.
+5 ; IA# 3535 [Subscription] Calls to TIUSRVP.
+6 ; IA# 4508 [Subscription] Call to TIUSRVPT.
+7 ; IA# 10060 [Supported] Access to NEW PERSON file (#200).
+8 ; IA# 10104 [Supported] Routine XLFSTR calls
+9 ;
ADDMSG ; [Procedure] Add message to transaction
+1 NEW MDIEN,MDIENS,MDRET
+2 if '$GET(DATA("TRANSACTION"))
QUIT
+3 if $GET(DATA("MESSAGE"))=""
QUIT
+4 SET MDIEN=+DATA("TRANSACTION")
SET MDIENS="+1,"_MDIEN_","
+5 DO NOW^%DTC
SET DATA("DATE")=%
KILL %
+6 SET MDFDA(702.091,MDIENS,.01)=+$ORDER(^MDD(702,+MDIEN,.091,"A"),-1)+1
+7 SET MDFDA(702.091,MDIENS,.02)=DATA("DATE")
+8 SET MDFDA(702.091,MDIENS,.03)=$GET(DATA("PKG"),"UNKNOWN")
+9 SET MDFDA(702.091,MDIENS,.09)=DATA("MESSAGE")
+10 DO UPDATE^DIE("","MDFDA","MDRET")
+11 QUIT
FILEMSG(STUDY,MDPKG,MDSTAT,MDMSG) ; [Procedure] File Study Status and Message.
+1 NEW DATA
+2 SET DATA("TRANSACTION")=STUDY
SET DATA("PKG")=MDPKG
+3 SET DATA("MESSAGE")=$PIECE(MDMSG,"^",2)
+4 DO STATUS(STUDY_",",MDSTAT,$PIECE(MDMSG,"^",2))
DO ADDMSG
+5 QUIT
+6 ;
NEWSTAT ; [Procedure] RPC Call to set status
+1 SET MDFDA(702,DATA,.09)=TYPE
+2 DO FILE^DIE("","MDFDA")
+3 IF TYPE=3&($GET(^MDK(704.202,+DATA,0))'="")
KILL MDFDA
SET MDFDA(704.202,DATA,.09)=0
DO FILE^DIE("","MDFDA")
KILL MDFDA
+4 QUIT
+5 ;
STATUS(MDIENS,MDSTAT,MDMSG) ; [Procedure] Update transaction status
+1 SET MDFDA(702,MDIENS,.08)=$GET(MDMSG)
+2 SET MDFDA(702,MDIENS,.09)=MDSTAT
+3 DO FILE^DIE("","MDFDA")
+4 QUIT
+5 ;
NEWTIUN(STUDY,RECID) ; [Function] Create a new TIU for transaction
+1 ; Input: STUDY - IENS of CP study entry
+2 ; Return: TIU Document IEN
+3 NEW CTR,DFN,MDADD,MDCON,MDCONRS,MDCT,MDDAR,MDFDA,MDGST,MDL,MDLOC,MDNOTE,MDPDT,MDPROC,MDRESU,MDTI,MDTCHK,MDTITL,MDTRE,MDTSTR,MDNVST,MDVST,MDVSTR,MDWPA,MDPT,MDR,MDRP,MDRST,MDTX,MDUSR
+4 NEW MDHLS,MDHLS1,MDKK,MDFLST,MDLC,MDLL,MDX0
SET MDLC=0
+5 SET CTR=0
SET MDGST=+STUDY
SET MDRESU=""
+6 KILL ^TMP("MDDAR",$JOB)
NEW MDDAR2,GLOARR,MDMUS
SET MDMUS=0
+7 ; Get data for TIU Note Creation
+8 SET (MDTSTR,MDRESU)=$$GETDATA^MDRPCOT(MDGST)
+9 ; File Error message
+10 IF +MDRESU<0
DO FILEMSG(MDGST,"CP",2,MDRESU)
QUIT MDRESU
+11 IF $GET(MDTSTR)=""
QUIT "-1^No Data to Create TIU Document"
+12 FOR MDL="DFN","MDTITL","MDLOC","MDNOTE","MDCON","MDPROC","MDVSTR","MDNVST"
Begin DoDot:1
+13 SET CTR=CTR+1
SET @MDL=$PIECE(MDTSTR,"^",CTR)
End DoDot:1
+14 SET MDVST=""
+15 ; If previous TIU document exists, quit
+16 IF MDNOTE
QUIT MDNOTE
+17 IF 'MDLOC
QUIT "-1^No Hospital Location."
+18 SET MDUSR=$$FIND1^DIC(200,,"X","CLINICAL,DEVICE PROXY SERVICE","B")
+19 ; Create new visit, if no vstring
+20 SET MDPDT=$$PDT^MDRPCOT1(MDGST)
+21 IF 'MDPDT
SET MDPT=$ORDER(^MDD(703.1,"ASTUDYID",+MDGST,""),-1)
SET MDPDT=$PIECE($GET(^MDD(703.1,+MDPT,0)),U,3)
+22 ; If No D/T Performed grab visit D/T
if 'MDPDT
SET MDPDT=$PIECE(MDVSTR,";",2)
+23 IF $PIECE(MDVSTR,";",3)="V"
SET $PIECE(MDVSTR,";",3)="A"
+24 ; Build variables for TIU Call
+25 ; Undicated Status
SET MDWPA(.05)=1
+26 ; Package Reference
SET MDWPA(1405)=+MDCON_";GMR(123,"
+27 ; Default Procedure Summary Code "Machine Resulted"
SET MDWPA(70201)=5
+28 ; Date/Time Performed
IF MDPDT
SET MDWPA(70202)=MDPDT
+29 ; File PCE Error message
+30 SET MDDAR=$NAME(^TMP("MDDAR",$JOB))
SET MDDAR2=$NAME(GLOARR)
+31 ;S MDRP=0 F S MDRP=$O(^MDD(702,+MDGST,.1,MDRP)) Q:'MDRP D
+32 ;.S MDRST=$P($G(^MDD(702,MDGST,.1,0)),"^",3)
+33 IF +RECID
DO CICNV^MDHL7U3(+RECID,.MDDAR)
DO SETGLO^MDRPCW1(.MDDAR,.MDDAR2)
+34 KILL ^TMP("MDDAR",$JOB)
+35 IF +$GET(@MDDAR2@("POV",0))>0
FOR MDLL=1:1:+$GET(@MDDAR2@("POV",0))
SET MDLC=MDLC+1
SET MDFLST(MDLC)=$GET(@MDDAR2@("POV",MDLL))
+36 IF +$GET(@MDDAR2@("CPT",0))>0
FOR MDLL=1:1:+$GET(@MDDAR2@("CPT",0))
SET MDLC=MDLC+1
SET MDFLST(MDLC)=$GET(@MDDAR2@("CPT",MDLL))
+37 SET MDRESU=$$EN1^MDPCE2(.MDFLST,MDGST,$PIECE(MDVSTR,";",2),MDPROC,$PIECE(MDVSTR,";",3),"P",MDLOC)
IF +MDRESU
SET MDVST=+MDRESU
+38 IF MDNVST&(+MDRESU<0)
DO FILEMSG(MDGST,"PCE",2,$PIECE(MDRESU,"^",2))
QUIT MDRESU
+39 ; Create the TIU note stub
+40 SET MDNOTE=""
DO MAKE^TIUSRVP(.MDNOTE,DFN,MDTITL,$PIECE(MDVSTR,";",2),MDLOC,$SELECT(MDVST:MDVST,1:""),.MDWPA,MDVSTR,1,1)
+41 IF '(+MDNOTE)
SET $PIECE(MDNOTE,"^")=-1
QUIT MDNOTE
+42 ; Finalize the transaction
+43 SET MDFDA(702,STUDY_",",.06)=+MDNOTE
+44 SET MDFDA(702,STUDY_",",.08)=""
+45 if MDVST>0
SET MDFDA(702,STUDY_",",.13)=MDVST
+46 DO FILE^DIE("","MDFDA")
+47 DO UPD^MDKUTLR(STUDY,+MDNOTE)
+48 if $$UP^XLFSTR($$GET1^DIQ(702,+STUDY_",",".11","E"))["MUSE"
SET MDMUS=1
+49 SET MDHLS=$PIECE(^MDS(702.01,+$PIECE(^MDD(702,+STUDY,0),"^",4),0),"^")
+50 SET MDHLS1=$$GET^XPAR("SYS","MD GET HIGH VOLUME",MDHLS,"E")
+51 KILL MDHLS,MDWPA
DO GETTXT^MDAR7M(.MDWPA,RECID)
+52 IF $GET(MDWPA("TEXT",1,0))=""
QUIT 1
+53 IF $GET(MDWPA("TEXT",0))["AMENDMENT"
Begin DoDot:1
+54 DO NOW^%DTC
KILL MDFDA
+55 SET MDFDA(702.091,"+1,"_STUDY_",",.01)=+$ORDER(^MDD(702,+STUDY,.091,"A"),-1)+1
+56 SET MDFDA(702.091,"+1,"_STUDY_",",.02)=%
KILL %
+57 SET MDFDA(702.091,"+1,"_STUDY_",",.03)="CLINICAL PROCEDURES"
+58 SET MDFDA(702.091,"+1,"_STUDY_",",.09)="AMENDMENT"
+59 DO UPDATE^DIE("","MDFDA")
End DoDot:1
+60 IF $GET(MDWPA(1202))=""&('+$PIECE(MDHLS1,";",2))
SET MDWPA(1202)=MDUSR
SET MDWPA(1204)=MDUSR
SET MDWPA(1302)=MDUSR
+61 SET MDWPA(.05)=5
SET MDTI=""
+62 IF +$PIECE(MDHLS1,";",2)&('+$$GET^XPAR("SYS","MD USE NOTE",1))
NEW MDADAR,MDCCN
SET MDCCN=0
Begin DoDot:1
+63 SET MDCT=0
FOR
SET MDCT=$ORDER(MDWPA("TEXT",MDCT))
if MDCT<1
QUIT
SET MDADAR=$GET(MDWPA("TEXT",MDCT,0))
Begin DoDot:2
+64 if '$GET(RECID)
QUIT
+65 SET ^MDD(703.1,+RECID,.4,MDCT,0)=MDADAR
SET MDCCN=MDCCN+1
+66 QUIT
End DoDot:2
+67 SET ^MDD(703.1,+RECID,.4,0)="^^"_MDCCN_"^"_MDCCN_"^"_DT_"^"
+68 KILL MDWPA
QUIT
End DoDot:1
QUIT 1
+69 DO UPDATE^TIUSRVP(.MDTI,+MDNOTE,.MDWPA,1)
+70 ;I +$$GET^XPAR("SYS","MD NOT ADMN CLOSE MUSE NOTE",1) S MDCONRS=$$CPDOC^GMRCCP(+MDCON,+MDNOTE,2) Q 1
+71 IF +$PIECE(MDHLS1,";",2)&(+$$GET^XPAR("SYS","MD USE NOTE",1))
SET MDCONRS=$$CPDOC^GMRCCP(+MDCON,+MDNOTE,2)
QUIT 1
+72 IF +MDNOTE&MDTI'<1
DO ADMNCLOS^TIUSRVPT(.MDR,+MDNOTE,"M",MDWPA(1202))
+73 QUIT 1
