Changeset 636 for FOIAVistA/tag/r/CLINICAL_PROCEDURES-MD/MDRPCOT.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• CLINICAL_PROCEDURES-MD/MDRPCOT.m (modified) (10 diffs)

FOIAVistA/tag/r/CLINICAL_PROCEDURES-MD/MDRPCOT.m

@@ -1 @@
-MDRPCOT ; HOIFO/DP/NCA - Object RPCs (TMDTransaction) ;3/12/08  09:18
- ;;1.0;CLINICAL PROCEDURES;**5,6**;Apr 01, 2004;Build 102
+MDRPCOT ; HOIFO/DP/NCA - Object RPCs (TMDTransaction) ;12/5/02  15:33
+ ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
  ; Integration Agreements:
  ; IA# 2693 [Subscription] TIU Extractions.
@@ -22 +22 @@
  ; Sets @RESULTS@(0)="-1^Reason for not deleting" or "1^Study Deleted"
  ;
- N MDAST,MDHOLD,MDNOTE,MDRES,MDSIEN,BODY,SUBJECT,DEVIEN
+ N MDHOLD,MDNOTE,MDRES,MDSIEN
  S (MDHOLD,MDSIEN)=+DATA,MDRES=0,MDNOTE=""
- D ALERT^MDHL7U3(MDSIEN) ; Builds the body of the mail message
- I $G(^MDD(702,+MDSIEN,0))="" S @RESULTS@(0)="1^Study Deleted." D NOTICE^MDHL7U3(SUBJECT,.BODY,DEVIEN,DUZ) Q  ;deleting message
  S:+$P(^MDD(702,MDSIEN,0),U,6) MDNOTE=$P(^MDD(702,MDSIEN,0),U,6)
  I "13"[$P(^MDD(702,MDSIEN,0),U,9) S @RESULTS@(0)="-1^Can't Delete TIU Note from a "_$$GET1^DIQ(702,MDSIEN,.09,"E")_" Study." Q
@@ -37 +35 @@
  .Q
  E  D
- .I $D(^MDD(702.001,"ASTUDY",MDSIEN)) S @RESULTS@(0)="-1^Note associated with study, can not delete." Q
- .S MDAST=$$HL7CHK^MDHL7U3(+MDSIEN) I +MDAST<1 S @RESULTS@(0)=MDAST Q
- .D NOTICE^MDHL7U3(SUBJECT,.BODY,DEVIEN,DUZ) ; delete message
  .S MDFDA(702,DATA_",",.01)=""
- .; Check for renal study to delete as well
- .S:$D(^MDK(704.202,DATA)) MDFDA(704.202,DATA_",",.01)=""
  .D FILE^DIE("","MDFDA")
  .N DA,DIK S DA=+MDSIEN,DIK="^MDD(702," D ^DIK
@@ -58 +51 @@
  NEW MDFDA,MDIEN,MDIENS,MDRET,P1,P2,P3,P4
  S P1=$P(DATA,U,1),P2=$P(DATA,U,2),P3=$P(DATA,U,3),P4=$P(DATA,U,4)
- S MDIEN=0 I $G(^MDD(702,+P1,0))="" Q
+ S MDIEN=0
  ; Look for file (All comparisons done on lower case values)
  F  S MDIEN=$O(^MDD(702,P1,.1,MDIEN)) Q:'MDIEN  D  Q:X=P3
@@ -99 +92 @@
  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
  ;
@@ -124 +116 @@
  S MDRESUL=$$NEWTIUN(MDSTUDY)
  ; File TIU Error messages
+ ;I +MDRESUL<0 D FILEMSG(MDSTUDY,"TIU",2,MDRESUL) Q MDRESUL
  I +MDRESUL<0 D  Q
  .D FILEMSG(MDSTUDY,"TIU",2,MDRESUL)
@@ -168 +161 @@
  .S MDVSTR=$$GETVSTR^MDRPCOT1(DFN,MDVSTR,MDPROC,$$GET1^DIQ(702,MDIEN,.02,"I"))
  .S MDLOC=$P(MDVSTR,";",1)
- I $$GET1^DIQ(702.01,+MDPROC_",",.12,"I")=1 Q DFN_"^"_MDTITL_"^"_MDLOC_"^^"_MDCON_"^"_MDPROC_"^"_MDVSTR_"^"_MDNVST
  ; Does TIU doc already exist?
  I $$GET1^DIQ(702,MDIEN,.06,"I") Q DFN_"^"_MDTITL_"^"_MDLOC_"^"_+$$GET1^DIQ(702,MDIEN,.06,"I")_"^"_MDCON_"^"_MDPROC_"^"_MDVSTR_"^"_MDNVST
@@ -178 +170 @@
  ; Input: STUDY - IENS of CP study entry
  ; Return: TIU Document IEN
- N CTR,DFN,MDCON,MDFDA,MDGST,MDL,MDLOC,MDNOTE,MDPDT,MDPROC,MDRESU,MDTITL,MDTSTR,MDVST,MDVSTR,MDWP,MDPT S CTR=0,MDGST=+STUDY,MDRESU=""
+ N CTR,DFN,MDCON,MDFDA,MDGST,MDL,MDLOC,MDNOTE,MDPDT,MDPROC,MDRESU,MDTITL,MDTSTR,MDVST,MDVSTR,MDWP S CTR=0,MDGST=+STUDY,MDRESU=""
  ; Get data for TIU Note Creation
  S (MDTSTR,MDRESU)=$$GETDATA(MDGST)
@@ -192 +184 @@
  ; Create new visit, if no vstring
  S MDPDT=$$PDT^MDRPCOT1(MDGST)
- I 'MDPDT S MDPT=$O(^MDD(703.1,"ASTUDYID",+MDGST,0)),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 MDWP(.05)=1 ; Undicated Status
  S MDWP(1405)=+MDCON_";GMR(123," ; Package Reference
- S MDWP(70201)=5 ; Default Procedure Summary Code "Machine Resulted"
  I MDPDT S MDWP(70202)=MDPDT ; Date/Time Performed
  ; File PCE Error message
- I MDNVST S MDRESU=$$EN1^MDPCE(MDGST,$P(MDVSTR,";",2),MDPROC,$P(MDVSTR,";",3),"P") I +MDRESU S MDVST=+MDRESU,MDVSTR=$P(MDRESU,"^",2)
+ I MDNVST S MDRESU=$$EN1^MDPCE(MDGST,MDPDT,MDPROC,$P(MDVSTR,";",3),"P") I +MDRESU S MDVST=+MDRESU,MDVSTR=$P(MDRESU,"^",2)
  I MDNVST&(+MDRESU<0) D FILEMSG(MDGST,"PCE",2,$P(MDRESU,"^",2)) Q MDRESU
  ; Create the TIU note stub
@@ -209 +198 @@
  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)
  Q 1
  ;