MDWORSR ; HOIFO/NCA - Daily Schedule Studies;Apr 4, 2018@11:53 ; 2/11/19 10:35am
;;1.0;CLINICAL PROCEDURES;**14,11,21,20,54,69**;Apr 01,2004;Build 2
; 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 MDACL,MDCON,MDCV,MDERR,MDFDA,MDHOLD,MDKK,MDL,MDL1,MDLSP,MDMAXD,MDNOW,MDSTAT,MDV,MDX,MDXY
S MDMAXD=DT+.24 K ^TMP("MDACLN",$J)
D GETLST^XPAR(.MDLSP,"SYS","MD CLINIC ASSOCIATION")
F MDKK=0:0 S MDKK=$O(MDLSP(MDKK)) Q:MDKK<1 S MDV=$P($G(MDLSP(MDKK)),"^",2) I +$P(MDV,";",2)>0 S MDACL=+MDV D
.S ^TMP("MDACLN",$J,+MDACL,+$P(MDV,";",2))=+$P(MDV,";",2)
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
..S MDHOLD=$P($G(^MDD(702,+MDL1,0)),"^",7),MDNOW=$$NOW^XLFDT()
..S $P(^MDD(702,+MDL1,0),"^",7)=MDHOLD
.S MDCV=$P(MDHOLD,";",3)
.I +MDXY&(+MDCV) Q:$G(^TMP("MDACLN",$J,+MDCV,+MDXY))=""
.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")
K ^TMP("MDACLN",$J)
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 MDATYP,MDHOLD,MDLST1,MDLST2,MDNEW,MDT,MDY3,MDY4 S MDDT=DT\1,MDEND=DT+.24 N MDINP K ^TMP($J,"SDAMA202","GETPLIST"),^TMP("MDSTATUS",$J) S MDCOM=0,MDHOLD=""
K ^TMP("MDMULT",$J),^TMP("MDCLINIC",$J),^TMP("MDLST",$J)
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 ASSOCIATION")
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)
; 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=$P($G(MDLST(MDK)),"^",2) I +$P(MDY,";",2)>0 S MDCL=+MDY D
.S:$G(^TMP("MDCLINIC",$J,+MDCL))="" ^TMP("MDCLINIC",$J,+MDCL)=+MDCL
.S ^TMP("MDLST",$J,+MDCL,+$P(MDY,";",2))=+$P(MDY,";",2)
.S MDMULT=+$$GET1^DIQ(702.01,+$P(MDY,";",2)_",",.12,"I")
.S MDHEMO=+$$GET1^DIQ(702.01,+$P(MDY,";",2)_",",.06,"I")
.Q:MDMULT'=1&(MDHEMO<2)
.S ^TMP("MDMULT",$J,+MDK)=+MDCL_";"_+$P(MDY,";",2)
.Q
K MDLST,MDY F MDK=0:0 S MDK=$O(^TMP("MDCLINIC",$J,MDK)) Q:MDK<1 S MDY=MDK D
.K ^TMP($J,"SDAMA202","GETPLIST") S MDCL=+MDY
.D GETPLIST^SDAMA202(+MDY,"1;4;3","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 MDATYP=$G(^TMP($J,"SDAMA202","GETPLIST",MD,3)) Q:MDATYP=""
..Q:"RINT"'[MDATYP
..S MDT=MDK,MDDX=+$$MATCH(+MDY1,MDT) 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)=MDSCHD
..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
K MDY F MDK=0:0 S MDK=$O(^TMP("MDMULT",$J,MDK)) Q:MDK<1 S MDY=$G(^(MDK)) I +$P(MDY,";",2)>0 S MDCL=+MDY D
.K ^TMP($J,"SDAMA202","GETPLIST")
.D GETPLIST^SDAMA202(+MDY,"1;4;3","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 MDATYP=$G(^TMP($J,"SDAMA202","GETPLIST",MD,3))
..Q:"RINT"'[MDATYP
..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,"^",9)
..Q:$P(MDNODE,"^",9)>3
..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)=MDSCHD
..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
K ^TMP("MDCLINIC",$J),^TMP("MDMULT",$J),^TMP("MDLST",$J)
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)_"^"_+MDCF_"^"_$P(MDCF,"^",6),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
GPRO(MDPAT,MDCLIN) ; Get procedure for study
N MDX,MDCF,MDCFX S MDCF="" K ^TMP("MDTMP",$J) D CPLIST^GMRCCP(MDPAT,,$NA(^TMP("MDTMP",$J)))
S MDX=0 F S MDX=$O(^TMP("MDTMP",$J,MDX)) Q:'MDX!(MDCF'="") D:"sap"[$P(^(MDX),U,4)
.S MDCFX=$G(^TMP("MDTMP",$J,MDX)) Q:'+$G(^TMP("MDLST",$J,MDCLIN,+$P(MDCFX,"^",6)))
.Q:+$O(^MDD(702,"ACON",+$P(MDCFX,"^",5),0)) S MDCF=MDCFX Q
K ^TMP("MDTMP",$J)
Q $S(MDCF'="":MDCF,1:0)
MATCH(MDPAT,MDCLIN) ; Match study to appointment
N MDI,MDY2 S MDY2=0
F MDI=0:0 S MDI=$O(^TMP("MDSTATUS",$J,MDPAT,MDI)) Q:MDI<1!(+MDY2) D
.I +$G(^TMP("MDLST",$J,MDCLIN,MDI)) S MDY2=+$G(^TMP("MDSTATUS",$J,MDPAT,MDI))
Q MDY2
ADD(MDPAT,MDY3,MDY4,MDCLIN,MDSC) ; Add study, if none exist
N MDFDA,MDERR,MDIENS,MDP,MDPS
Q:'MDY3
K MDFDA,MDERR,MDIENN
S MDP=$O(^MDD(702,"B",MDPAT,0)),MDPS=$G(^MDD(702,+MDP,0))
S MDFDA(702,"+1,",.01)=MDPAT
S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
S MDFDA(702,"+1,",.03)=$S(+$P(MDPS,"^",3):$P(MDPS,"^",3),1:DUZ)
S MDFDA(702,"+1,",.04)=+MDY3
S MDFDA(702,"+1,",.05)=+MDY4
S MDFDA(702,"+1,",.07)="A;"_MDSC_";"_MDCLIN
S MDFDA(702,"+1,",.11)=+$$GINST(+MDY3)
D UPDATE^DIE("","MDFDA","MDIENN","MDERR") Q:$D(MDERR) 0
K MDFDA
Q MDIENN(1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDWORSR 9084 printed Oct 16, 2024@17:45:21 Page 2
MDWORSR ; HOIFO/NCA - Daily Schedule Studies;Apr 4, 2018@11:53 ; 2/11/19 10:35am
+1 ;;1.0;CLINICAL PROCEDURES;**14,11,21,20,54,69**;Apr 01,2004;Build 2
+2 ; Reference IA# 2263 [Supported] XPAR calls
+3 ; 3067 [Private] Read fields in Consult file (#123) w/FM
+4 ; 3468 [Subscription] Call GMRCCP
+5 ; 3869 [Subscription] SDAMA202 calls
+6 ; 10035 [Supported] Patient File Access
+7 ; 10103 [Supported] XLFDT calls
+8 ;
EN1 ; Entry Point to process scheduled studies
+1 NEW MDACL,MDCON,MDCV,MDERR,MDFDA,MDHOLD,MDKK,MDL,MDL1,MDLSP,MDMAXD,MDNOW,MDSTAT,MDV,MDX,MDXY
+2 SET MDMAXD=DT+.24
KILL ^TMP("MDACLN",$JOB)
+3 DO GETLST^XPAR(.MDLSP,"SYS","MD CLINIC ASSOCIATION")
+4 FOR MDKK=0:0
SET MDKK=$ORDER(MDLSP(MDKK))
if MDKK<1
QUIT
SET MDV=$PIECE($GET(MDLSP(MDKK)),"^",2)
IF +$PIECE(MDV,";",2)>0
SET MDACL=+MDV
Begin DoDot:1
+5 SET ^TMP("MDACLN",$JOB,+MDACL,+$PIECE(MDV,";",2))=+$PIECE(MDV,";",2)
End DoDot:1
+6 SET MDL=DT
FOR
SET MDL=$ORDER(^MDD(702,"ASD",MDL))
if MDL<1!(MDL>MDMAXD)
QUIT
FOR MDL1=0:0
SET MDL1=$ORDER(^MDD(702,"ASD",MDL,MDL1))
if MDL1<1
QUIT
SET MDX=$GET(^MDD(702,MDL1,0))
Begin DoDot:1
+7 KILL MDFDA
+8 SET MDCON=+$PIECE(MDX,"^",5)
if 'MDCON
QUIT
+9 SET MDSTAT=$$GET1^DIQ(123,MDCON_",",8,"E")
+10 if MDSTAT="DISCONTINUED"!(MDSTAT="CANCELLED")
QUIT
+11 if +$PIECE(MDX,"^",9)>0
QUIT
+12 SET MDIENS=MDL1_","
SET MDXY=+$PIECE(MDX,"^",4)
SET MDHOLD=""
IF MDXY
Begin DoDot:2
+13 SET MDHOLD=$PIECE($GET(^MDD(702,+MDL1,0)),"^",7)
SET MDNOW=$$NOW^XLFDT()
+14 SET $PIECE(^MDD(702,+MDL1,0),"^",7)=MDHOLD
End DoDot:2
+15 SET MDCV=$PIECE(MDHOLD,";",3)
+16 IF +MDXY&(+MDCV)
if $GET(^TMP("MDACLN",$JOB,+MDCV,+MDXY))=""
QUIT
+17 SET MDHL7=$$SUB^MDHL7B(MDL1)
+18 IF +MDHL7=-1
SET MDFDA(702,MDIENS,.09)=2
SET MDFDA(702,MDIENS,.08)=$PIECE(MDHL7,U,2)
+19 IF +MDHL7=1
SET MDFDA(702,MDIENS,.02)=$$NOW^XLFDT()
SET MDFDA(702,MDIENS,.09)=5
SET MDFDA(702,MDIENS,.08)=""
+20 if $DATA(MDFDA)
DO FILE^DIE("","MDFDA","MDERR")
+21 SET MDXY=+$PIECE(MDX,"^",4)
if 'MDXY
QUIT
+22 ; Renal Check-In
IF $PIECE(^MDS(702.01,MDXY,0),U,6)=2
Begin DoDot:2
+23 DO CP^MDKUTL(+MDIENS)
+24 if $GET(MDHOLD)'=""
SET MDFDA(702,MDIENS,.07)=MDHOLD
+25 SET MDFDA(702,MDIENS,.09)=5
+26 DO FILE^DIE("","MDFDA","MDERR")
End DoDot:2
QUIT
End DoDot:1
+27 KILL ^TMP("MDACLN",$JOB)
+28 QUIT
CLINICPT ; Check-in CP study with multiple results
+1 NEW 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
+2 NEW MDATYP,MDHOLD,MDLST1,MDLST2,MDNEW,MDT,MDY3,MDY4
SET MDDT=DT\1
SET MDEND=DT+.24
NEW MDINP
KILL ^TMP($JOB,"SDAMA202","GETPLIST"),^TMP("MDSTATUS",$JOB)
SET MDCOM=0
SET MDHOLD=""
+3 KILL ^TMP("MDMULT",$JOB),^TMP("MDCLINIC",$JOB),^TMP("MDLST",$JOB)
+4 SET MDNUM=$$GET^XPAR("SYS","MD COMPL PROC DISPLAY DAYS",1)
+5 IF +MDNUM>0
SET X1=DT
SET X2=-MDNUM
DO C^%DTC
SET MDCOM=X
+6 DO GETLST^XPAR(.MDLST,"SYS","MD CLINIC ASSOCIATION")
+7 FOR MDLP=0:0
SET MDLP=$ORDER(^MDD(702,"AS",0,MDLP))
if MDLP<1
QUIT
Begin DoDot:1
+8 SET MDY=$GET(^MDD(702,MDLP,0))
if +$PIECE(MDY,"^",9)>0
QUIT
+9 if $PIECE(MDY,"^",7)'=""
QUIT
+10 if '+$PIECE(MDY,"^",5)!($PIECE(MDY,"^",6)'="")
QUIT
+11 if '+MDY
QUIT
+12 IF '+$GET(^TMP("MDSTATUS",$JOB,+MDY,+$PIECE(MDY,"^",4)))
SET ^TMP("MDSTATUS",$JOB,+MDY,+$PIECE(MDY,"^",4))=+MDLP
+13 QUIT
End DoDot:1
+14 ; Combine clinics with multiple procedures to regular clinics
+15 SET MDLST2=$SELECT(+MDLST>0:MDLST,1:0)
+16 ; Match new studies with 0 status to appointments
+17 NEW MDXX
KILL MDY
FOR MDK=0:0
SET MDK=$ORDER(MDLST(MDK))
if MDK<1
QUIT
SET MDY=$PIECE($GET(MDLST(MDK)),"^",2)
IF +$PIECE(MDY,";",2)>0
SET MDCL=+MDY
Begin DoDot:1
+18 if $GET(^TMP("MDCLINIC",$JOB,+MDCL))=""
SET ^TMP("MDCLINIC",$JOB,+MDCL)=+MDCL
+19 SET ^TMP("MDLST",$JOB,+MDCL,+$PIECE(MDY,";",2))=+$PIECE(MDY,";",2)
+20 SET MDMULT=+$$GET1^DIQ(702.01,+$PIECE(MDY,";",2)_",",.12,"I")
+21 SET MDHEMO=+$$GET1^DIQ(702.01,+$PIECE(MDY,";",2)_",",.06,"I")
+22 if MDMULT'=1&(MDHEMO<2)
QUIT
+23 SET ^TMP("MDMULT",$JOB,+MDK)=+MDCL_";"_+$PIECE(MDY,";",2)
+24 QUIT
End DoDot:1
+25 KILL MDLST,MDY
FOR MDK=0:0
SET MDK=$ORDER(^TMP("MDCLINIC",$JOB,MDK))
if MDK<1
QUIT
SET MDY=MDK
Begin DoDot:1
+26 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
SET MDCL=+MDY
+27 DO GETPLIST^SDAMA202(+MDY,"1;4;3","R",MDDT,MDEND,.MDRET,"")
+28 FOR MD=0:0
SET MD=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST",MD))
if 'MD
QUIT
Begin DoDot:2
+29 SET MDY1=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",MD,4))
if MDY1<1
QUIT
+30 SET MDSCHD=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",MD,1))
+31 SET MDATYP=$GET(^TMP($JOB,"SDAMA202","GETPLIST",MD,3))
if MDATYP=""
QUIT
+32 if "RINT"'[MDATYP
QUIT
+33 SET MDT=MDK
SET MDDX=+$$MATCH(+MDY1,MDT)
if 'MDDX
QUIT
+34 SET MDMULT=+$$GET1^DIQ(702,+MDDX,".04:.12","I")
+35 SET MDHEMO=+$$GET1^DIQ(702,+MDDX,".04:.06","I")
SET MDIENS=+MDDX_","
+36 SET MDFDA(702,MDIENS,.02)=$$NOW^XLFDT()
+37 SET MDFDA(702,MDIENS,.07)="A;"_MDSCHD_";"_MDCL
+38 SET MDFDA(702,MDIENS,.14)=MDSCHD
+39 if $DATA(MDFDA)
DO FILE^DIE("","MDFDA","MDERR")
KILL MDFDA
+40 IF MDHEMO=2
SET MDHOLD=$PIECE($GET(^MDD(702,+MDIENS,0)),"^",7)
SET MDNEW=$$NOW^XLFDT()
SET $PIECE(^MDD(702,+MDIENS,0),"^",7)=MDSCHD
+41 SET MDHL7=$$SUB^MDHL7B(+MDIENS)
+42 IF +MDHL7=-1
SET MDFDA(702,MDIENS,.09)=2
SET MDFDA(702,MDIENS,.08)=$PIECE(MDHL7,U,2)
+43 IF +MDHL7=1
SET MDFDA(702,MDIENS,.09)=5
SET MDFDA(702,MDIENS,.08)=""
+44 if $DATA(MDFDA)
DO FILE^DIE("","MDFDA","MDERR")
+45 if '+$GET(MDIENS)
QUIT
+46 IF MDHEMO=2
DO CP^MDKUTL(+MDIENS)
if $GET(MDHOLD)'=""
SET MDFDA(702,+MDIENS_",",.07)=MDHOLD
SET MDFDA(702,+MDIENS_",",.09)=5
DO FILE^DIE("","MDFDA","MDERR")
KILL MDFDA
+47 QUIT
End DoDot:2
+48 QUIT
End DoDot:1
+49 ; Match the rest of appointments with previous studies
+50 NEW MDGET,MDINST
SET X1=DT
SET X2=-365
DO C^%DTC
SET MDCDT=X
+51 KILL MDY
FOR MDK=0:0
SET MDK=$ORDER(^TMP("MDMULT",$JOB,MDK))
if MDK<1
QUIT
SET MDY=$GET(^(MDK))
IF +$PIECE(MDY,";",2)>0
SET MDCL=+MDY
Begin DoDot:1
+52 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
+53 DO GETPLIST^SDAMA202(+MDY,"1;4;3","R",MDDT,MDEND,.MDRET,"")
+54 FOR MD=0:0
SET MD=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST",MD))
if 'MD
QUIT
Begin DoDot:2
+55 SET MDINP=0
+56 SET MDY1=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",MD,4))
if MDY1<1
QUIT
+57 SET MDSCHD=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",MD,1))
+58 SET MDATYP=$GET(^TMP($JOB,"SDAMA202","GETPLIST",MD,3))
+59 if "RINT"'[MDATYP
QUIT
+60 SET MDPT=MDY1
if +$$GSTUDY(MDPT,MDSCHD)
QUIT
+61 SET MDDX=$$GETC(MDPT,+$PIECE(MDY,";",2))
if '+MDDX
QUIT
+62 SET MDNODE=$GET(^MDD(702,+MDDX,0))
+63 if $GET(^DPT(MDY1,.105))'=""
SET MDINP=1
+64 SET MDCON=$PIECE(MDNODE,"^",5)
if 'MDCON
QUIT
+65 SET MDVSTR=$PIECE(MDNODE,"^",7)
if MDVSTR=""
QUIT
+66 SET MDMULT=+$$GET1^DIQ(702,+MDDX,".04:.12","I")
+67 SET MDHEMO=+$$GET1^DIQ(702,+MDDX,".04:.06","I")
+68 SET MDYR=$SELECT(MDMULT<1:MDCOM,1:MDCDT)
+69 if $PIECE(MDNODE,"^",2)<MDYR
QUIT
+70 if '$PIECE(MDNODE,"^",9)
QUIT
+71 if $PIECE(MDNODE,"^",9)>3
QUIT
+72 if $PIECE(MDVSTR,";",2)=MDSCHD
QUIT
+73 SET MDINST=+$$GINST(+$PIECE(MDNODE,"^",4))
if 'MDINST
QUIT
+74 KILL MDFDA,MDERR,MDIEN
+75 SET MDFDA(702,"+1,",.01)=MDY1
+76 SET MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
+77 SET MDFDA(702,"+1,",.03)=$PIECE(MDNODE,"^",3)
+78 SET MDFDA(702,"+1,",.04)=$PIECE(MDNODE,"^",4)
+79 SET MDFDA(702,"+1,",.05)=MDCON
+80 SET MDFDA(702,"+1,",.07)="A;"_MDSCHD_";"_MDCL
+81 SET MDFDA(702,"+1,",.11)=+MDINST
+82 SET MDFDA(702,"+1,",.14)=MDSCHD
+83 DO UPDATE^DIE("","MDFDA","MDIEN","MDERR")
if $DATA(MDERR)
QUIT
KILL MDFDA
+84 SET MDIENS=MDIEN(1)_","
IF MDHEMO=2
SET MDHOLD=$PIECE($GET(^MDD(702,MDIEN(1),0)),"^",7)
SET MDNOW=$$NOW^XLFDT()
SET $PIECE(^MDD(702,MDIEN(1),0),"^",7)=MDSCHD
+85 SET MDHL7=$$SUB^MDHL7B(MDIEN(1))
+86 IF +MDHL7=-1
SET MDFDA(702,MDIENS,.09)=2
SET MDFDA(702,MDIENS,.08)=$PIECE(MDHL7,U,2)
+87 IF +MDHL7=1
SET MDFDA(702,MDIENS,.09)=5
SET MDFDA(702,MDIENS,.08)=""
+88 if $DATA(MDFDA)
DO FILE^DIE("","MDFDA","MDERR")
+89 if '+$GET(MDIENS)
QUIT
+90 IF MDHEMO=2
DO CP^MDKUTL(+MDIENS)
KILL MDFDA
if $GET(MDHOLD)'=""
SET MDFDA(702,+MDIENS_",",.07)=MDHOLD
SET MDFDA(702,+MDIENS_",",.09)=5
DO FILE^DIE("","MDFDA","MDERR")
End DoDot:2
End DoDot:1
+91 KILL ^TMP($JOB,"SDAMA202","GETPLIST"),^TMP("MDSTATUS",$JOB),MDFDA
+92 KILL ^TMP("MDCLINIC",$JOB),^TMP("MDMULT",$JOB),^TMP("MDLST",$JOB)
+93 QUIT
GETC(MDPAT,MDDA) ; Get consult date
+1 NEW MDX,MDCF
SET MDCF=0
KILL ^TMP("MDTMP",$JOB)
DO CPLIST^GMRCCP(MDPAT,+MDDA,$NAME(^TMP("MDTMP",$JOB)))
+2 SET MDX=$ORDER(^TMP("MDTMP",$JOB,""),-1)
if '+MDX
QUIT 0
+3 IF "saprc"'[$PIECE($GET(^TMP("MDTMP",$JOB,MDX)),U,4)
SET MDX=$ORDER(^TMP("MDTMP",$JOB,MDX),-1)
if '+MDX
QUIT 0
+4 IF "saprc"[$PIECE($GET(^TMP("MDTMP",$JOB,MDX)),U,4)
SET MDCF=$PIECE($GET(^TMP("MDTMP",$JOB,MDX)),U,5)_"^"_$PIECE($GET(^TMP("MDTMP",$JOB,MDX)),U,1)
+5 KILL ^TMP("MDTMP",$JOB)
+6 QUIT $SELECT(+MDCF:+$ORDER(^MDD(702,"ACON",+MDCF,""),-1)_"^"_$PIECE(MDCF,"^",2)_"^"_+MDCF_"^"_$PIECE(MDCF,"^",6),1:0)
GINST(MDDA) ; Get instrument from CP Definition
+1 NEW MDIN,MDINT,Y1
SET (MDINT,Y1)=0
+2 FOR MDIN=0:0
SET MDIN=$ORDER(^MDS(702.01,+MDDA,.1,MDIN))
if MDIN<1!(+Y1)
QUIT
SET MDINT=+$GET(^(MDIN,0))
IF +$$GET1^DIQ(702.09,MDINT,".13","I")
SET Y1=MDINT
+3 QUIT Y1
GSTUDY(MDPAT,MDDA) ;Get study for scheduled date/time
+1 NEW MDIN,Y1
SET Y1=0
+2 FOR MDIN=0:0
SET MDIN=$ORDER(^MDD(702,"ASD",MDDA,MDIN))
if MDIN<1!(Y1>0)
QUIT
Begin DoDot:1
+3 if $PIECE($GET(^MDD(702,MDIN,0)),"^")=MDPAT
SET Y1=1
End DoDot:1
+4 QUIT Y1
GPRO(MDPAT,MDCLIN) ; Get procedure for study
+1 NEW MDX,MDCF,MDCFX
SET MDCF=""
KILL ^TMP("MDTMP",$JOB)
DO CPLIST^GMRCCP(MDPAT,,$NAME(^TMP("MDTMP",$JOB)))
+2 SET MDX=0
FOR
SET MDX=$ORDER(^TMP("MDTMP",$JOB,MDX))
if 'MDX!(MDCF'="")
QUIT
if "sap"[$PIECE(^(MDX),U,4)
Begin DoDot:1
+3 SET MDCFX=$GET(^TMP("MDTMP",$JOB,MDX))
if '+$GET(^TMP("MDLST",$JOB,MDCLIN,+$PIECE(MDCFX,"^",6)))
QUIT
+4 if +$ORDER(^MDD(702,"ACON",+$PIECE(MDCFX,"^",5),0))
QUIT
SET MDCF=MDCFX
QUIT
End DoDot:1
+5 KILL ^TMP("MDTMP",$JOB)
+6 QUIT $SELECT(MDCF'="":MDCF,1:0)
MATCH(MDPAT,MDCLIN) ; Match study to appointment
+1 NEW MDI,MDY2
SET MDY2=0
+2 FOR MDI=0:0
SET MDI=$ORDER(^TMP("MDSTATUS",$JOB,MDPAT,MDI))
if MDI<1!(+MDY2)
QUIT
Begin DoDot:1
+3 IF +$GET(^TMP("MDLST",$JOB,MDCLIN,MDI))
SET MDY2=+$GET(^TMP("MDSTATUS",$JOB,MDPAT,MDI))
End DoDot:1
+4 QUIT MDY2
ADD(MDPAT,MDY3,MDY4,MDCLIN,MDSC) ; Add study, if none exist
+1 NEW MDFDA,MDERR,MDIENS,MDP,MDPS
+2 if 'MDY3
QUIT
+3 KILL MDFDA,MDERR,MDIENN
+4 SET MDP=$ORDER(^MDD(702,"B",MDPAT,0))
SET MDPS=$GET(^MDD(702,+MDP,0))
+5 SET MDFDA(702,"+1,",.01)=MDPAT
+6 SET MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
+7 SET MDFDA(702,"+1,",.03)=$SELECT(+$PIECE(MDPS,"^",3):$PIECE(MDPS,"^",3),1:DUZ)
+8 SET MDFDA(702,"+1,",.04)=+MDY3
+9 SET MDFDA(702,"+1,",.05)=+MDY4
+10 SET MDFDA(702,"+1,",.07)="A;"_MDSC_";"_MDCLIN
+11 SET MDFDA(702,"+1,",.11)=+$$GINST(+MDY3)
+12 DO UPDATE^DIE("","MDFDA","MDIENN","MDERR")
if $DATA(MDERR)
QUIT 0
+13 KILL MDFDA
+14 QUIT MDIENN(1)
