MDNCHK ; HOIFO/NCA - CP Multiple Result Check ;7/26/10 14:27
;;1.0;CLINICAL PROCEDURES;**11,21,20**;Apr 01, 2004;Build 9
; Reference
; IA# 2056 [Supported] Call to DIQ.
; IA# 10103 [Supported] Call to XLFDT
;
CHK(MDIEN) ; RPC call to notify Consult of results
; Input parameters
; 1. MDIEN [Literal/Required] CP Study
;
N MDCLST,MDCLT,MDCX,MDDEF,MDERR,MDHLOC,MDIENS,MDION,MDFDA,MDSTAT,MDSTR,MDSUBL S MDCX=""
I '$G(MDIEN) S MDIEN="" Q MDIEN
S MDDEF=+$$GET1^DIQ(702,MDIEN,.04,"I") I 'MDDEF Q MDIEN
S MDSTR=$G(^MDD(702,MDIEN,0)) I MDSTR="" Q MDIEN
I $P(MDSTR,"^",9)=6 D Q MDCX
.S MDCLST=$$GET1^DIQ(123,+$P(MDSTR,"^",5)_",",8,"E")
.I MDCLST="CANCELLED"!(MDCLST="DISCONTINUED") S MDCLT=$$GETCS^MDRPCOTA(+MDIEN) D
..I +MDCLT S MDCX=$O(^MDD(702,"ACON",+MDCLT,""),-1) I 'MDCX K MDFDA S MDFDA(702,+MDIEN,.05)=MDCLT D FILE^DIE("","MDFDA") K MDFDA S MDCX=+MDIEN
..S:'MDCX MDCX=+MDIEN
..Q
.Q
S MDSTAT=+$$GET1^DIQ(702.01,MDDEF,.12,"I") I 'MDSTAT Q MDIEN
S MDION=+$$GET1^DIQ(702,MDIEN,.12,"I") I 'MDION Q MDIEN
I MDSTAT=2 Q MDIEN
I $P(MDSTR,"^",9)'=3 Q MDIEN
K ^MDD(702,"AION",+MDION,MDIEN)
S MDSUBL=$P(MDSTR,U,7)
S MDHLOC=+$$GET1^DIQ(702.01,MDDEF,.05,"I"),MDSUBL=$P(MDSUBL,";",1,2)_";"_MDHLOC
S MDFDA(702,"+1,",.01)=$P(MDSTR,U,1)
S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
S MDFDA(702,"+1,",.03)=$P(MDSTR,U,3)
S MDFDA(702,"+1,",.04)=$P(MDSTR,U,4)
S MDFDA(702,"+1,",.05)=$P(MDSTR,U,5)
S MDFDA(702,"+1,",.07)=$P(MDSTR,U,7)
S MDFDA(702,"+1,",.09)=5
S MDFDA(702,"+1,",.11)=$P(MDSTR,U,11)
S MDFDA(702,"+1,",.12)=$P(MDSTR,U,12)
D UPDATE^DIE("","MDFDA","MDIENS","MDERR")
S MDIEN=MDIENS(1)
Q MDIEN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDNCHK 1653 printed Dec 13, 2024@01:43:04 Page 2
MDNCHK ; HOIFO/NCA - CP Multiple Result Check ;7/26/10 14:27
+1 ;;1.0;CLINICAL PROCEDURES;**11,21,20**;Apr 01, 2004;Build 9
+2 ; Reference
+3 ; IA# 2056 [Supported] Call to DIQ.
+4 ; IA# 10103 [Supported] Call to XLFDT
+5 ;
CHK(MDIEN) ; RPC call to notify Consult of results
+1 ; Input parameters
+2 ; 1. MDIEN [Literal/Required] CP Study
+3 ;
+4 NEW MDCLST,MDCLT,MDCX,MDDEF,MDERR,MDHLOC,MDIENS,MDION,MDFDA,MDSTAT,MDSTR,MDSUBL
SET MDCX=""
+5 IF '$GET(MDIEN)
SET MDIEN=""
QUIT MDIEN
+6 SET MDDEF=+$$GET1^DIQ(702,MDIEN,.04,"I")
IF 'MDDEF
QUIT MDIEN
+7 SET MDSTR=$GET(^MDD(702,MDIEN,0))
IF MDSTR=""
QUIT MDIEN
+8 IF $PIECE(MDSTR,"^",9)=6
Begin DoDot:1
+9 SET MDCLST=$$GET1^DIQ(123,+$PIECE(MDSTR,"^",5)_",",8,"E")
+10 IF MDCLST="CANCELLED"!(MDCLST="DISCONTINUED")
SET MDCLT=$$GETCS^MDRPCOTA(+MDIEN)
Begin DoDot:2
+11 IF +MDCLT
SET MDCX=$ORDER(^MDD(702,"ACON",+MDCLT,""),-1)
IF 'MDCX
KILL MDFDA
SET MDFDA(702,+MDIEN,.05)=MDCLT
DO FILE^DIE("","MDFDA")
KILL MDFDA
SET MDCX=+MDIEN
+12 if 'MDCX
SET MDCX=+MDIEN
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
QUIT MDCX
+15 SET MDSTAT=+$$GET1^DIQ(702.01,MDDEF,.12,"I")
IF 'MDSTAT
QUIT MDIEN
+16 SET MDION=+$$GET1^DIQ(702,MDIEN,.12,"I")
IF 'MDION
QUIT MDIEN
+17 IF MDSTAT=2
QUIT MDIEN
+18 IF $PIECE(MDSTR,"^",9)'=3
QUIT MDIEN
+19 KILL ^MDD(702,"AION",+MDION,MDIEN)
+20 SET MDSUBL=$PIECE(MDSTR,U,7)
+21 SET MDHLOC=+$$GET1^DIQ(702.01,MDDEF,.05,"I")
SET MDSUBL=$PIECE(MDSUBL,";",1,2)_";"_MDHLOC
+22 SET MDFDA(702,"+1,",.01)=$PIECE(MDSTR,U,1)
+23 SET MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
+24 SET MDFDA(702,"+1,",.03)=$PIECE(MDSTR,U,3)
+25 SET MDFDA(702,"+1,",.04)=$PIECE(MDSTR,U,4)
+26 SET MDFDA(702,"+1,",.05)=$PIECE(MDSTR,U,5)
+27 SET MDFDA(702,"+1,",.07)=$PIECE(MDSTR,U,7)
+28 SET MDFDA(702,"+1,",.09)=5
+29 SET MDFDA(702,"+1,",.11)=$PIECE(MDSTR,U,11)
+30 SET MDFDA(702,"+1,",.12)=$PIECE(MDSTR,U,12)
+31 DO UPDATE^DIE("","MDFDA","MDIENS","MDERR")
+32 SET MDIEN=MDIENS(1)
+33 QUIT MDIEN
