- 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 Jan 18, 2025@02:44:18 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