source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCOT1.m@ 1150

Last change on this file since 1150 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1MDRPCOT1 ; HOIFO/NCA/DP - Object RPCs (TMDTransaction) - Continued ; [08-02-2002 12:55]
2 ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
3 ; Integration Agreements:
4 ; IA# 3468 [Subscription] GMRCCP API.
5 ; IA# 3567 [Subscription] MAGGSIUI API
6 ; IA# 10040 [Supported] Hospital Location File Access
7 ; IA# 10061 [Supported] Calls to VADPT
8 ; IA# 10103 [Supported] Calls to XLFDT.
9 ;
10DELERR(MDTIEN) ; [Procedure] Delete Imaging Error Messages
11 S MDLP=0 F S MDLP=$O(^MDD(702,MDTIEN,.091,MDLP)) Q:'MDLP D
12 .K DA,DIK
13 .S DA=+MDLP,DA(1)=+MDTIEN,DIK="^MDD(702,"_DA(1)_",.091," D ^DIK
14 .Q
15 Q
16 ;
17IMGSTAT(STUDY,MDSTAT) ; [Procedure] Update the Image Status.
18 N MDL
19 S MDL=0 F S MDL=$O(^MDD(702,STUDY,.1,MDL)) Q:MDL<1 S $P(^(MDL,0),"^",9)=MDSTAT
20 Q
21 ;
22GETVSTR(DFN,MDSSTR,MDPR,MDTR) ; [Function] Check the Visit String
23 N MDCLOC,MDLOC,MDINPT,VAIP
24 I '$G(MDTR) Q 0
25 I '$G(MDPR) Q 0
26 I $G(MDSSTR)="" Q 0
27 S VAIP("D")=MDTR ; DT of Transaction Created
28 D IN5^VADPT S MDINPT=$S(+VAIP(13):1,1:0)
29 S MDCLOC=$$GET1^DIQ(702.01,+MDPR_",",.05,"I")
30 I 'MDCLOC S MDCLOC=+$P(MDSSTR,";",3) I 'MDCLOC Q 0
31 S Y=MDCLOC_";"_$P(MDSSTR,";",2)_";"_$P(MDSSTR,";")
32 I $P(Y,";",3)="A" Q Y
33 S:$P(Y,";",3)="" $P(Y,";",3)="A"
34 S:+MDINPT $P(Y,";",3)="A"
35 Q Y
36 ;
37PDT(STUDY) ; [Function] Loop through the attachments for Date/Time Performed.
38 N MDL,MDDT
39 S MDL=0,MDDT=""
40 F S MDL=$O(^MDD(702,STUDY,.1,MDL)) Q:'MDL D Q:MDDT
41 .S MDDT=$P($G(^MDD(702,STUDY,.1,MDL,0)),"^",3)
42 I MDDT S MDDT=$P($G(^MDD(703.1,+MDDT,0)),"^",3) ; Get Date/Time Performed
43 Q MDDT
44 ;
45SUBMIT(STUDY) ; [Function] Submit all non-pending/uncomplete images in transaction to Imaging
46 N DATA,MDACQ,MDC,MDCRES,MDCTR,MDLOC,MDAR,MDARR,MDDT,MDFDA,MDDEL,MDIEN,MDIENS,MDIMG,MDL,MDMAG,MDR,MDST,MDX,MDY,MDZ
47 S MDIEN=+STUDY,MDIENS=MDIEN_","
48 S MDST=$$GET1^DIQ(702,MDIEN,.09,"I") I "13"[MDST Q "-1^Study not in proper status"
49 D DELERR(+MDIEN)
50 I $$GET1^DIQ(702,MDIEN,.01)="" Q "-1^No Entry in file (#702)."
51 D NOW^%DTC S MDDT=%
52 S MDMAG("IDFN")=+$$GET1^DIQ(702,MDIEN,.01,"I")
53 I 'MDMAG("IDFN") Q "-1^No Patient DFN."
54 S MDMAG("PXPKG")=8925
55 S MDMAG("PXIEN")=+$$GET1^DIQ(702,MDIEN,.06,"I")
56 I 'MDMAG("PXIEN") Q "-1^No TIU IEN"
57 I '$O(^MDD(702,MDIEN,.1,0)) D Q $S(+MDR<0:MDR,1:"3^Transaction Complete")
58 .S MDC=$$GET1^DIQ(702,MDIEN,.05,"I")
59 .S MDR=$$UPDCONS(MDC,MDMAG("PXIEN"))
60 S MDMAG("STSCB")="ISTAT^MDAPI"
61 S MDMAG("TRKID")="CP;"_MDIEN_"-"_MDDT
62 S MDLOC=$$GET1^DIQ(702,MDIEN,.07,"I"),MDLOC=$P(MDLOC,";",3)
63 I 'MDLOC Q "-1^No Hospital Location."
64 S MDMAG("ACQS")=$S(+$$GET1^DIQ(44,MDLOC_",",3,"I"):+$$GET1^DIQ(44,MDLOC_",",3,"I"),1:+$G(DUZ(2)))
65 S MDMAG("ACQL")=MDLOC
66 S MDX=$$GET1^DIQ(702,MDIEN,.04,"I")
67 S MDZ=$P(^MDS(702.01,+MDX,0),"^",1)
68 S (MDACQ,MDX,MDDEL)="",MDCTR=0
69 N MDTOT S MDTOT=$$GET1^DIQ(702,MDIENS,.991)
70 S MDL=0 F S MDL=$O(^MDD(702,MDIEN,.1,MDL)) Q:MDL<1 S MDX=$G(^(MDL,0)) D
71 .S:'MDDEL MDDEL=$P(MDX,"^",3)
72 .S MDY=$G(^MDD(702,MDIEN,.1,MDL,.1)) Q:MDY=""
73 .S:MDACQ="" MDACQ=$P($P(MDY,"\\",2),"\")
74 .S:"12"[$P(MDX,"^",9) $P(MDX,"^",9)=""
75 .I $P(MDX,"^",9)="" S MDCTR=MDCTR+1,MDARR(MDCTR)=MDY_"^"_MDZ_" image "_MDCTR_" out of "_MDTOT
76 .Q
77 I '$O(MDARR(0)) Q "-1^No UNC."
78 S MDMAG("GDESC")=MDZ_" Result"
79 I MDDEL S MDY=$P($G(^MDD(703.1,+MDDEL,0)),"^",3,4),MDMAG("PXDT")=$P(MDY,"^",1),MDY=+$P(MDY,"^",2),MDMAG("ACQD")=$P($G(^MDS(702.09,+MDY,0)),"^"),MDMAG("DFLG")=+$P($G(^MDS(702.09,+MDY,0)),"^",5)
80 S:$G(MDMAG("ACQD"))="" MDMAG("ACQD")=MDACQ
81 S:'$G(MDMAG("PXDT")) MDMAG("PXDT")=MDDT ; If no date, use NOW in MDDT
82 S MDMAG("TRTYPE")="NEW"
83 D IMPORT^MAGGSIUI(.MDIMG,.MDARR,.MDMAG)
84 I '(+$G(MDIMG(0))) D Q "-1^"_$P(MDIMG(0),"^",2)
85 .D IMGSTAT(+MDIENS,1)
86 .F MDAR=0:0 S MDAR=$O(MDIMG(MDAR)) Q:'MDAR I $G(MDIMG(MDAR))'="" D
87 ..S DATA("MESSAGE")=$$TRANS^MDAPI(MDIMG(MDAR)) D ADDMSG^MDRPCOT
88 D IMGSTAT(+MDIENS,0)
89 Q "1^Images Submitted"
90 ;
91UPDCONS(MDC,MDDOC) ; [Function] Update Consults Procedure Status
92 N MDCRES
93 S MDCRES=$$CPDOC^GMRCCP(MDC,MDDOC,2)
94 I '(+MDCRES) Q "-1^"_$P(MDCRES,"^",2)
95 Q 1
96 ;
97GETIORD(MDIEN) ; [Function] Return the Instrument order number for this study
98 ; Called from instrument interface routines
99 Q:'$D(^MDD(702,MDIEN,0))#2 -1 ; No such study
100 Q:'$P(^MDD(702,MDIEN,0),U,12) $$NEWIORD(MDIEN) ; Create a new one
101 Q $P(^MDD(702,MDIEN,0),U,12) ; Return the existing one
102 ;
103NEWIORD(MDIEN) ; [Function] Generate & return new unique instrument order number
104 ; Notice: will overwrite existing order number if it exists
105 N MDFDA
106 Q:'$D(^MDD(702,MDIEN,0))#2 -1 ; No such study
107 L +^MDD(702,"AION"):15 E Q -1 ; Unable to lock and guarantee uniqueness
108 F D Q:'$D(^MDD(702,"AION",X)) H 1 ; Loop until unique
109 . S X=$$NOW^XLFDT() ; Current DateTime
110 . S X=$TR($J(X,14,6),".","") ; Pad with 0's and strip the decimal
111 . Q
112 I $E($G(^MDS(702.09,DEVIEN,0)),1,4)="Muse" D
113 . ; Due to current limitation to the Muse can only except 9
114 . S X=$E($TR($H,",",""),2,10) ; Using $E($H) only for the MUSE
115 . I '$D(^MDD(702,"AION",X)) Q ; It is unique and quit
116 . N I,FLG ; Not unique
117 . S FLG=0
118 . F I=1:1 D Q:FLG
119 . . S X=X+1
120 . . I '$D(^MDD(702,"AION",X)) S FLG=1
121 . . Q
122 . Q
123 S MDFDA(702,MDIEN_",",.12)=X ; Build FDA
124 D FILE^DIE("","MDFDA") ; File it
125 L -(^MDD(702,"AION")) ; Unlock it
126 Q $P(^MDD(702,MDIEN,0),U,12) ; Return it from the file
127 ;
128GETSTDY(MDION) ; [Function] Return study from instrument order number
129 ; Called from instrument interface routines
130 Q:'$D(^MDD(702,"AION",MDION)) -1 ; No such order number
131 Q $O(^MDD(702,"AION",MDION,"")) ; Return the 702 ien
132 ;
Note: See TracBrowser for help on using the repository browser.