134 lines
6.8 KiB
Mathematica
134 lines
6.8 KiB
Mathematica
MDWORSR ; HOIFO/NCA - Daily Schedule Studies;7/2/04 12:39 ;5/17/07 16:09
|
|
;;1.0;CLINICAL PROCEDURES;**14**;Apr 01,2004;Build 20
|
|
; Reference IA# 2263 [Supported] XPAR calls
|
|
; 3067 [Private] Read fields in Consult file (#123) w/FM
|
|
; 3468 [Subscription] Call GMRCCP
|
|
; 3869 [Subscription] SDAMA202 calls
|
|
; 10035 [Supported] Patient File Access
|
|
; 10103 [Supported] XLFDT calls
|
|
;
|
|
EN1 ; Entry Point to process scheduled studies
|
|
N MDCON,MDERR,MDFDA,MDHOLD,MDL,MDL1,MDMAXD,MDNOW,MDSTAT,MDX,MDXY
|
|
S MDMAXD=DT+.24
|
|
S MDL=DT F S MDL=$O(^MDD(702,"ASD",MDL)) Q:MDL<1!(MDL>MDMAXD) F MDL1=0:0 S MDL1=$O(^MDD(702,"ASD",MDL,MDL1)) Q:MDL1<1 S MDX=$G(^MDD(702,MDL1,0)) D
|
|
.K MDFDA
|
|
.S MDCON=+$P(MDX,"^",5) Q:'MDCON
|
|
.S MDSTAT=$$GET1^DIQ(123,MDCON_",",8,"E")
|
|
.Q:MDSTAT="DISCONTINUED"!(MDSTAT="CANCELLED")
|
|
.Q:+$P(MDX,"^",9)>0
|
|
.S MDIENS=MDL1_",",MDXY=+$P(MDX,"^",4),MDHOLD="" I MDXY D
|
|
..Q:$P(^MDS(702.01,MDXY,0),U,6)'=2
|
|
..S MDHOLD=$P($G(^MDD(702,+MDL1,0)),"^",7),MDNOW=$$NOW^XLFDT()
|
|
..S $P(^MDD(702,+MDL1,0),"^",7)=$S(MDNOW>MDL:MDL,1:MDNOW)
|
|
.S MDHL7=$$SUB^MDHL7B(MDL1)
|
|
.I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
|
|
.I +MDHL7=1 S MDFDA(702,MDIENS,.02)=$$NOW^XLFDT(),MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
|
|
.D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
|
|
.S MDXY=+$P(MDX,"^",4) Q:'MDXY
|
|
.I $P(^MDS(702.01,MDXY,0),U,6)=2 D Q ; Renal Check-In
|
|
..D CP^MDKUTL(+MDIENS)
|
|
..S:$G(MDHOLD)'="" MDFDA(702,MDIENS,.07)=MDHOLD
|
|
..S MDFDA(702,MDIENS,.09)=5
|
|
..D FILE^DIE("","MDFDA","MDERR")
|
|
Q
|
|
CLINICPT ; Check-in CP study with multiple results
|
|
N MD,MDCDT,MDCL,MDCOM,MDCON,MDDT,MDDX,MDEND,MDERR,MDFDA,MDHEMO,MDHL7,MDIEN,MDIENS,MDK,MDLP,MDLST,MDMULT,MDNODE,MDNUM,MDPT,MDRET,MDSCHD,MDVSTR,MDY,MDY1,MDYR,X,X1,X2
|
|
N MDHOLD,MDLST1,MDLST2,MDNEW S MDDT=DT\1,MDEND=DT+.24 N MDINP K ^TMP($J,"SDAMA202","GETPLIST"),^TMP("MDSTATUS",$J) S MDCOM=0,MDHOLD=""
|
|
S MDNUM=$$GET^XPAR("SYS","MD COMPL PROC DISPLAY DAYS",1)
|
|
I +MDNUM>0 S X1=DT,X2=-MDNUM D C^%DTC S MDCOM=X
|
|
D GETLST^XPAR(.MDLST,"SYS","MD CLINIC QUICK LIST")
|
|
D GETLST^XPAR(.MDLST1,"SYS","MD CLINICS WITH MULT PROC")
|
|
F MDLP=0:0 S MDLP=$O(^MDD(702,"AS",0,MDLP)) Q:MDLP<1 D
|
|
.S MDY=$G(^MDD(702,MDLP,0)) Q:+$P(MDY,"^",9)>0
|
|
.Q:$P(MDY,"^",7)'=""
|
|
.Q:'+$P(MDY,"^",5)!($P(MDY,"^",6)'="")
|
|
.Q:'+MDY
|
|
.I '+$G(^TMP("MDSTATUS",$J,+MDY,+$P(MDY,"^",4))) S ^TMP("MDSTATUS",$J,+MDY,+$P(MDY,"^",4))=+MDLP
|
|
.Q
|
|
; Combine clinics with multiple procedures to regular clinics
|
|
S MDLST2=$S(+MDLST>0:MDLST,1:0)
|
|
I MDLST1>0 K MDY F MDK=0:0 S MDK=$O(MDLST1(MDK)) Q:MDK<1 I $G(MDLST1(MDK))'="" S MDY=$P($G(MDLST1(MDK)),"^",2)_"^"_+$G(MDLST1(MDK)),MDLST2=MDLST2+1,MDLST(MDLST2)=MDY
|
|
; Match new studies with 0 status to appointments
|
|
N MDXX K MDY F MDK=0:0 S MDK=$O(MDLST(MDK)) Q:MDK<1 S MDY=$G(MDLST(MDK)) I +$P(MDY,"^",2)>0 S MDCL=+MDY D
|
|
.K ^TMP($J,"SDAMA202","GETPLIST")
|
|
.D GETPLIST^SDAMA202(+MDY,"1;4;","R",MDDT,MDEND,.MDRET,"")
|
|
.F MD=0:0 S MD=$O(^TMP($J,"SDAMA202","GETPLIST",MD)) Q:'MD D
|
|
..S MDY1=+$G(^TMP($J,"SDAMA202","GETPLIST",MD,4)) Q:MDY1<1
|
|
..S MDSCHD=+$G(^TMP($J,"SDAMA202","GETPLIST",MD,1))
|
|
..S MDDX=+$G(^TMP("MDSTATUS",$J,MDY1,+$P(MDY,"^",2))) Q:'MDDX
|
|
..S MDMULT=+$$GET1^DIQ(702,+MDDX,".04:.12","I")
|
|
..S MDHEMO=+$$GET1^DIQ(702,+MDDX,".04:.06","I"),MDIENS=+MDDX_","
|
|
..S MDFDA(702,MDIENS,.02)=$$NOW^XLFDT()
|
|
..S MDFDA(702,MDIENS,.07)="A;"_MDSCHD_";"_MDCL
|
|
..S MDFDA(702,MDIENS,.14)=MDSCHD
|
|
..D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR") K MDFDA
|
|
..I MDHEMO=2 S MDHOLD=$P($G(^MDD(702,+MDIENS,0)),"^",7),MDNEW=$$NOW^XLFDT(),$P(^MDD(702,+MDIENS,0),"^",7)=$S(MDNEW>MDSCHD:MDSCHD,1:MDNEW)
|
|
..S MDHL7=$$SUB^MDHL7B(+MDIENS)
|
|
..I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
|
|
..I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
|
|
..D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
|
|
..Q:'+$G(MDIENS)
|
|
..I MDHEMO=2 D CP^MDKUTL(+MDIENS) S:$G(MDHOLD)'="" MDFDA(702,+MDIENS_",",.07)=MDHOLD S MDFDA(702,+MDIENS_",",.09)=5 D FILE^DIE("","MDFDA","MDERR") K MDFDA
|
|
..Q
|
|
.Q
|
|
; Match the rest of appointments with previous studies
|
|
N MDGET,MDINST S X1=DT,X2=-365 D C^%DTC S MDCDT=X
|
|
F MDK=0:0 S MDK=$O(MDLST(MDK)) Q:MDK<1 S MDY=$G(MDLST(MDK)) I +$P(MDY,"^",2)>0 S MDCL=+MDY D
|
|
.K ^TMP($J,"SDAMA202","GETPLIST")
|
|
.D GETPLIST^SDAMA202(+MDY,"1;4;","R",MDDT,MDEND,.MDRET,"")
|
|
.F MD=0:0 S MD=$O(^TMP($J,"SDAMA202","GETPLIST",MD)) Q:'MD D
|
|
..S MDINP=0
|
|
..S MDY1=+$G(^TMP($J,"SDAMA202","GETPLIST",MD,4)) Q:MDY1<1
|
|
..S MDSCHD=+$G(^TMP($J,"SDAMA202","GETPLIST",MD,1))
|
|
..S MDPT=MDY1 Q:+$$GSTUDY(MDPT,MDSCHD)
|
|
..S MDDX=$$GETC(MDPT,+$P(MDY,"^",2)) Q:'+MDDX
|
|
..S MDNODE=$G(^MDD(702,+MDDX,0))
|
|
..S:$G(^DPT(MDY1,.105))'="" MDINP=1
|
|
..S MDCON=$P(MDNODE,"^",5) Q:'MDCON
|
|
..S MDVSTR=$P(MDNODE,"^",7) Q:MDVSTR=""
|
|
..S MDMULT=+$$GET1^DIQ(702,+MDDX,".04:.12","I")
|
|
..S MDHEMO=+$$GET1^DIQ(702,+MDDX,".04:.06","I")
|
|
..S MDYR=$S(MDMULT<1:MDCOM,1:MDCDT)
|
|
..Q:$P(MDNODE,"^",2)<MDYR
|
|
..Q:'+$P(MDNODE,"^",6)
|
|
..Q:'$P(MDNODE,"^",9)
|
|
..Q:$P(MDNODE,"^",9)>3
|
|
..Q:MDMULT'=1&(MDHEMO<2)
|
|
..Q:$P(MDVSTR,";",2)=MDSCHD
|
|
..S MDINST=+$$GINST(+$P(MDNODE,"^",4)) Q:'MDINST
|
|
..K MDFDA,MDERR,MDIEN
|
|
..S MDFDA(702,"+1,",.01)=MDY1
|
|
..S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
|
|
..S MDFDA(702,"+1,",.03)=$P(MDNODE,"^",3)
|
|
..S MDFDA(702,"+1,",.04)=$P(MDNODE,"^",4)
|
|
..S MDFDA(702,"+1,",.05)=MDCON
|
|
..S MDFDA(702,"+1,",.07)="A;"_MDSCHD_";"_MDCL
|
|
..S MDFDA(702,"+1,",.11)=+MDINST
|
|
..S MDFDA(702,"+1,",.14)=MDSCHD
|
|
..D UPDATE^DIE("","MDFDA","MDIEN","MDERR") Q:$D(MDERR) K MDFDA
|
|
..S MDIENS=MDIEN(1)_"," I MDHEMO=2 S MDHOLD=$P($G(^MDD(702,MDIEN(1),0)),"^",7),MDNOW=$$NOW^XLFDT(),$P(^MDD(702,MDIEN(1),0),"^",7)=$S(MDNOW>MDSCHD:MDSCHD,1:MDNOW)
|
|
..S MDHL7=$$SUB^MDHL7B(MDIEN(1))
|
|
..I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
|
|
..I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
|
|
..D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
|
|
..Q:'+$G(MDIENS)
|
|
..I MDHEMO=2 D CP^MDKUTL(+MDIENS) K MDFDA S:$G(MDHOLD)'="" MDFDA(702,+MDIENS_",",.07)=MDHOLD S MDFDA(702,+MDIENS_",",.09)=5 D FILE^DIE("","MDFDA","MDERR")
|
|
K ^TMP($J,"SDAMA202","GETPLIST"),^TMP("MDSTATUS",$J),MDFDA
|
|
Q
|
|
GETC(MDPAT,MDDA) ; Get consult date
|
|
N MDX,MDCF S MDCF=0 K ^TMP("MDTMP",$J) D CPLIST^GMRCCP(MDPAT,+MDDA,$NA(^TMP("MDTMP",$J)))
|
|
S MDX=$O(^TMP("MDTMP",$J,""),-1) Q:'+MDX 0
|
|
I "saprc"'[$P($G(^TMP("MDTMP",$J,MDX)),U,4) S MDX=$O(^TMP("MDTMP",$J,MDX),-1) Q:'+MDX 0
|
|
I "saprc"[$P($G(^TMP("MDTMP",$J,MDX)),U,4) S MDCF=$P($G(^TMP("MDTMP",$J,MDX)),U,5)_"^"_$P($G(^TMP("MDTMP",$J,MDX)),U,1)
|
|
K ^TMP("MDTMP",$J)
|
|
Q $S(+MDCF:+$O(^MDD(702,"ACON",+MDCF,""),-1)_"^"_$P(MDCF,"^",2),1:0)
|
|
GINST(MDDA) ; Get instrument from CP Definition
|
|
N MDIN,MDINT,Y1 S (MDINT,Y1)=0
|
|
F MDIN=0:0 S MDIN=$O(^MDS(702.01,+MDDA,.1,MDIN)) Q:MDIN<1!(+Y1) S MDINT=+$G(^(MDIN,0)) I +$$GET1^DIQ(702.09,MDINT,".13","I") S Y1=MDINT
|
|
Q Y1
|
|
GSTUDY(MDPAT,MDDA) ;Get study for scheduled date/time
|
|
N MDIN,Y1 S Y1=0
|
|
F MDIN=0:0 S MDIN=$O(^MDD(702,"ASD",MDDA,MDIN)) Q:MDIN<1!(Y1>0) D
|
|
.S:$P($G(^MDD(702,MDIN,0)),"^")=MDPAT Y1=1
|
|
Q Y1
|