- 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 Mar 13, 2025@20:49:11 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)
