Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MDNCHK

MDNCHK.m

Go to the documentation of this file.
  1. 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
  1. ; Reference
  1. ; IA# 2056 [Supported] Call to DIQ.
  1. ; IA# 10103 [Supported] Call to XLFDT
  1. ;
  1. CHK(MDIEN) ; RPC call to notify Consult of results
  1. ; Input parameters
  1. ; 1. MDIEN [Literal/Required] CP Study
  1. ;
  1. N MDCLST,MDCLT,MDCX,MDDEF,MDERR,MDHLOC,MDIENS,MDION,MDFDA,MDSTAT,MDSTR,MDSUBL S MDCX=""
  1. I '$G(MDIEN) S MDIEN="" Q MDIEN
  1. S MDDEF=+$$GET1^DIQ(702,MDIEN,.04,"I") I 'MDDEF Q MDIEN
  1. S MDSTR=$G(^MDD(702,MDIEN,0)) I MDSTR="" Q MDIEN
  1. I $P(MDSTR,"^",9)=6 D Q MDCX
  1. .S MDCLST=$$GET1^DIQ(123,+$P(MDSTR,"^",5)_",",8,"E")
  1. .I MDCLST="CANCELLED"!(MDCLST="DISCONTINUED") S MDCLT=$$GETCS^MDRPCOTA(+MDIEN) D
  1. ..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
  1. ..S:'MDCX MDCX=+MDIEN
  1. ..Q
  1. .Q
  1. S MDSTAT=+$$GET1^DIQ(702.01,MDDEF,.12,"I") I 'MDSTAT Q MDIEN
  1. S MDION=+$$GET1^DIQ(702,MDIEN,.12,"I") I 'MDION Q MDIEN
  1. I MDSTAT=2 Q MDIEN
  1. I $P(MDSTR,"^",9)'=3 Q MDIEN
  1. K ^MDD(702,"AION",+MDION,MDIEN)
  1. S MDSUBL=$P(MDSTR,U,7)
  1. S MDHLOC=+$$GET1^DIQ(702.01,MDDEF,.05,"I"),MDSUBL=$P(MDSUBL,";",1,2)_";"_MDHLOC
  1. S MDFDA(702,"+1,",.01)=$P(MDSTR,U,1)
  1. S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
  1. S MDFDA(702,"+1,",.03)=$P(MDSTR,U,3)
  1. S MDFDA(702,"+1,",.04)=$P(MDSTR,U,4)
  1. S MDFDA(702,"+1,",.05)=$P(MDSTR,U,5)
  1. S MDFDA(702,"+1,",.07)=$P(MDSTR,U,7)
  1. S MDFDA(702,"+1,",.09)=5
  1. S MDFDA(702,"+1,",.11)=$P(MDSTR,U,11)
  1. S MDFDA(702,"+1,",.12)=$P(MDSTR,U,12)
  1. D UPDATE^DIE("","MDFDA","MDIENS","MDERR")
  1. S MDIEN=MDIENS(1)
  1. Q MDIEN