MDWSETUP ; HOIFO/NCA - Auto Study Check-In Setup ;3/18/08 14:14
;;1.0;CLINICAL PROCEDURES;**14,11,37,45**;Apr 01, 2004;Build 1
EN1 ; [Procedure]
; This post conversion routine will place the Medicine Enter/Edit
; options out of order
; Reference IA # 2263 [Supported] XPAR parameter calls
; 10040 [Supported] Accessing Hospital Location file (#44)
; 10103 [Supported] XLFDT call
; 06/04/2014 KAM MD*1*37 Rem Ticket1007464 Clinical Proc Auto Check-in
; 09/21/2015 KAM MD*1*45 CA/SDM Ticket I5605614FY15 clinic editing
;
N MDANS,MDAPT,MDAR,MDCL,MDCNOD,MDCP,MDCT,MDCTR,MDDEF,MDDFLT,MDERR,MDFLAG,MDFRST,MDLP,MDLAST,MDLST,MDLST1,MDLST2,MDNODE,MDNXT
N MDPREC,MDS,MDSAP,MDSED,MDSEL,MDX,MDX1,MDX2,MDX3,MDY,MDY1 K ^TMP("MDOLD",$J)
D GETLST^XPAR(.MDLST1,"SYS","MD CLINIC ASSOCIATION") I '+$G(MDLST1) D GET
S MDDEF=$$GET^XPAR("SYS","MD USE APPT WITH PROCEDURE",1),MDDEF=$S(+MDDEF:"YES",1:"NO")
K DIR S DIR(0)="YA",DIR("A")="Use Appointment with procedure? ",DIR("B")=MDDEF,DIR("?")="Enter either 'Y' or 'N'."
S DIR("?",1)="Default should be 'N' as most sites do not schedule procedures"
S DIR("?",2)="before the order is entered. Select 'Y' if the procedure appointment"
S DIR("?",3)="is scheduled before the order is entered and the ordering provider"
S DIR("?",4)="selects the appointment for the procedure."
D ^DIR K DIR Q:$D(DIRUT)!$D(DIROUT)!(Y<0)
;D DEL^XPAR("SYS","MD USE APPT WITH PROCEDURE",1)
D EN^XPAR("SYS","MD USE APPT WITH PROCEDURE",1,0)
D GETLST^XPAR(.MDLST,"SYS","MD CHECK-IN PROCEDURE LIST")
D GETLST^XPAR(.MDLST1,"SYS","MD CLINIC ASSOCIATION")
K ^TMP("MDPROC",$J),^TMP("MDPARAM",$J) S (MDCT,MDCTR,MDLAST)=0
; Get procedure parameter list
F MDLP=0:0 S MDLP=$O(MDLST(MDLP)) Q:MDLP<1 I +$G(MDLST(MDLP)) S MDX=$P($G(^MDS(702.01,+$G(MDLST(MDLP)),0)),"^",1) D
. Q:MDX="" S MDY=+$P($G(MDLST(MDLP)),"^",2)
. S ^TMP("MDPROC",$J,MDX,+$G(MDLST(MDLP)))=MDY_"^"_$S(MDY=1:"Outpatient",MDY=2:"Inpatient",MDY=3:"Both",1:"None")
; Get Clinic Quick List
F MDLP=0:0 S MDLP=$O(MDLST1(MDLP)) Q:MDLP<1 S MDX3=+$G(MDLST1(MDLP)),MDX2=$P($G(MDLST1(MDLP)),"^",2),MDX1=+$P(MDX2,";",2) I +MDX1 D
. S MDX=$P($G(^MDS(702.01,MDX1,0)),"^",1) Q:MDX=""
. S MDY=+$P(MDX2,";",1) Q:'MDY
. S MDCNOD=$G(^TMP("MDPROC",$J,MDX,MDX1)) Q:MDCNOD=""
. S MDY1=$$GET1^DIQ(44,MDY_",",.01),MDCTR=MDCTR+1
. S:$G(MDCTR(MDY))="" MDCTR(MDY)=0 S MDCTR(MDY)=MDCTR(MDY)+1
. S ^TMP("MDPARAM",$J,MDX,MDY1)=MDX1_"^"_MDY_"^"_MDCNOD_"^"_MDX3,MDLAST=MDX3
S MDPREC=$NA(^TMP("MDPROC",$J)) K MDLST,MDLST1
F S MDPREC=$Q(@MDPREC) Q:MDPREC="" Q:$QS(MDPREC,1)'="MDPROC" D
. I '$D(^TMP("MDPARAM",$J,$QS(MDPREC,3))) S MDCTR=MDCTR+1,^TMP("MDPARAM",$J,$QS(MDPREC,3),"None")=$QS(MDPREC,4)_"^^"_@MDPREC
QURY ; Query the procedure parameter list
I MDCTR<1 G A1
N MDN S MDPREC=$NA(^TMP("MDPARAM",$J)),(MDANS,MDN)="" D HDR
F S MDPREC=$Q(@MDPREC) Q:MDPREC="" Q:$QS(MDPREC,1)'="MDPARAM" D
. Q:MDANS="^"
. S MDAPT=@MDPREC,MDAPT=$P(MDAPT,"^",4)
. I $Y>(IOSL-2) K DIR S DIR(0)="E" D ^DIR K DIR D:Y HDR I $D(DIRUT)!$D(DIROUT)!(Y<0) S MDANS="^" Q
. I MDN'=$QS(MDPREC,3) W !,$E($QS(MDPREC,3),1,25),?27,MDAPT,?55,$E($QS(MDPREC,4),1,25) S MDN=$QS(MDPREC,3) Q
. W !?55,$E($QS(MDPREC,4),1,25)
A1 ; Ask for procedure parameter
W !!,"Procedure: " R X:DTIME G:'$T!("^"[X) KIL
I X["?" D PHELP^MDWCHK
K DIC S DIC="^MDS(702.01,",DIC(0)="EQMZ",DIC("S")="I +$P(^(0),U,9)>0"
D ^DIC K DIC G A1:"^"[X!$D(DTOUT),A1:Y<1
S MDSEL=Y,MDCP=+MDSEL
G:'$D(^TMP("MDPARAM",$J,Y(0,0))) A2
S MDFRST=$O(^TMP("MDPARAM",$J,Y(0,0),"")) G:MDFRST="" A2
S MDX1=$P($G(^TMP("MDPARAM",$J,Y(0,0),MDFRST)),"^",3)
S MDNXT=$O(^TMP("MDPARAM",$J,Y(0,0),MDFRST)),MDDFLT="",MDFLAG=0
I MDNXT="" S MDDFLT=$G(^TMP("MDPARAM",$J,Y(0,0),MDFRST)),MDNODE=MDFRST G E1
I MDNXT'="" D Q:+MDFLAG
. W ! S MDLP="",MDCT=0 F S MDLP=$O(^TMP("MDPARAM",$J,Y(0,0),MDLP)) Q:MDLP="" D
. . S MDCT=MDCT+1 W !,MDCT_") ",Y(0,0)," ",MDLP S MDAR(MDCT)=MDLP
. W ! K DIR S DIR(0)="NAO^1:"_MDCT,DIR("A")="Select 1-"_MDCT_": ",DIR("?")="Select from 1-"_MDCT D ^DIR
. I X="" S MDSED=MDSEL,MDSAP=MDX1,MDFLAG=1 Q
. ;
. ;06/04/2014 KAM MD*1*37 Rem Ticket1007464
. ;modified the next line to better handle "^"
. ;
. ;K DIR G:$D(DIRUT)!$D(DIROUT)!(Y<1) KIL S MDS=Y
. ;
. ;09/21/2015 KAM MD*1*45 CA/SDM Ticket I5605614FY15
. ;modified next line to correct clinic editing issue
. ;K DIR D:$D(DIRUT)!$D(DIROUT)!(Y<1) KIL S MDFLAG=1 Q
. K DIR S MDS=Y I $D(DIRUT)!$D(DIROUT)!(Y<1) D KIL S MDFLAG=1 Q
. ;
. S MDNODE=$G(MDAR(MDS))
. S MDDFLT=$G(^TMP("MDPARAM",$J,$P(MDSEL,"^",2),MDNODE))
E1 ; Edit the procedure
W !!,"Procedure: ",$P(MDSEL,"^",2)_"// " R X:DTIME G:'$T!(X=U) KIL
I X["?"!(X'="")&(X'="@") W !,"Hit Return to accept the procedure",!,"Enter ""@"" to delete the procedure.",!,"Enter a ""^"" will exit completely." G E1
I X="@" D G A1
. I MDNXT="" D EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST",$P(MDSEL,"^",2),"@")
. D EN^XPAR("SYS","MD CLINIC ASSOCIATION",+$P(MDDFLT,"^",5),"@")
. K ^TMP("MDPARAM",$J,$P(MDSEL,"^",2),MDNODE)
. S:+$P(MDDFLT,"^",2) MDCTR(+$P(MDDFLT,"^",2))=MDCTR(+$P(MDDFLT,"^",2))-1
. W " ..Procedure deleted"
S MDSED=MDSEL
E2 ; Ask whether appointment scheduled
K DIR S DIR(0)="SA^0:None;1:Outpatient;2:Inpatient;3:Both",DIR("A")="Schedule Appointment?: ",DIR("B")=+$P(MDDFLT,"^",3)
S DIR("?")="^D CHELP^MDWCHK"
D ^DIR K DIR
G:$D(DIRUT)!$D(DIROUT)!(Y<0) KIL S MDSAP=Y
I $G(MDDFLT)'="" D EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST",$P(MDSEL,"^",2),"@")
D EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST","`"_+MDSED,+MDSAP)
I MDSAP'=+$P(MDDFLT,"^",3) S MDLP="" F S MDLP=$O(^TMP("MDPARAM",$J,$P(MDSED,"^",2),MDLP)) Q:MDLP="" S MDX=$G(^(MDLP)) I $P(MDX,"^",3)'=+MDSAP D
. S $P(MDX,"^",3,4)=+MDSAP_"^"_$S(MDSAP=1:"Outpatient",MDSAP=2:"Inpatient",MDSAP=3:"Both",1:"None")
. S ^TMP("MDPARAM",$J,$P(MDSED,"^",2),MDLP)=MDX
I MDNODE["None" G A3
E3 ; Edit the location
W !,"Clinic: ",MDNODE_"// " R X:DTIME G:'$T!(X=U) KIL
I X["?"!(X'="")&(X'="@") W !,"Hit Return to accept the clinic",!,"Enter ""@"" to delete the clinic from the procedure.",!,"Enter a ""^"" will exit completely." G E3
I X="" G A4
I X="@" D G A4
. D:+$P(MDDFLT,"^",5) EN^XPAR("SYS","MD CLINIC ASSOCIATION",+$P(MDDFLT,"^",5),"@")
. S:+$P(MDDFLT,"^",2) MDCTR(+$P(MDDFLT,"^",2))=MDCTR(+$P(MDDFLT,"^",2))-1
. K ^TMP("MDPARAM",$J,$P(MDSEL,"^",2),MDNODE)
. I $G(MDNXT)="" S $P(MDDFLT,"^",2)="",^TMP("MDPARAM",$J,$P(MDSEL,"^",2),"None")=MDDFLT
. W " ..Value deleted"
S MDCL=+$P(MDDFLT,"^",2)_"^"_MDNODE
K MDCL,MDSEL
G A4
A2 ; Ask if site schedule appointments
K DIR S DIR(0)="SA^0:None;1:Outpatient;2:Inpatient;3:Both",DIR("A")="Schedule Appointment?: ",DIR("?")="^D CHELP^MDWCHK"
D ^DIR K DIR
I $D(DIRUT)!$D(DIROUT)!(Y<0) W "...Procedure removed" G KIL
S MDSAP=Y
D EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST","`"_+MDSEL,+MDSAP)
S ^TMP("MDPARAM",$J,$P(MDSEL,"^",2),"None")=+MDSEL_"^^"_MDSAP_"^"_$S(MDSAP=1:"Outpatient",MDSAP=2:"Inpatient",MDSAP=3:"Both",1:"None")
I 'MDSAP S MDCL="" D TASK G A1
A3 ; Ask for clinic value
W !,"Clinic: " R X:DTIME G:'$T!(X=U) KIL
I X["?" D CLHELP
I X="" S MDCL="" D:'+MDSAP TASK G A1
K DIC S DIC="^SC(",DIC(0)="EQMZ"
D ^DIC K DIC G A3:"^"[X!$D(DTOUT),A3:Y<1
S MDCL=Y D TASK
K ^TMP("MDPARAM",$J,$P(MDSEL,"^",2),"None")
S ^TMP("MDPARAM",$J,$P(MDSEL,"^",2),$P(MDCL,"^",2))=+MDSEL_"^"_+MDCL_"^"_MDSAP_"^"_$S(MDSAP=1:"Outpatient",MDSAP=2:"Inpatient",MDSAP=3:"Both",1:"None")
S:$G(MDCTR(+MDCL))="" MDCTR(+MDCL)=0 S MDCTR(+MDCL)=MDCTR(+MDCL)+1,MDLAST=MDLAST+1
D EN^XPAR("SYS","MD CLINIC ASSOCIATION",MDLAST,+MDCL_";"_+MDSEL)
A4 ; Ask for another Clinic
K DIR W ! S DIR(0)="YA",DIR("A")="Enter another clinic for the same procedure? ",DIR("B")="NO",DIR("?")="Enter either 'Y' or 'N', if you want to assign more than one clinic."
D ^DIR K DIR G:$D(DIRUT)!$D(DIROUT)!(Y<0) A4
I +Y G A3
G A1
KIL ; Clean Up TMP global arrays and exit
K DIROUT,DIRUT,MDCL,MDSEL,X,Y
K ^TMP("MDPROC",$J),^TMP("MDPARAM",$J)
Q
TASK ; Queue a task to process previous requests
K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE S ZTRTN="START^MDWCHK",ZTREQ="@",ZTSAVE("ZTREQ")="",ZTIO="",ZTDTH=$$NOW^XLFDT()
S ZTDESC="Check-In Studies for "_$P($G(^MDS(702.01,+MDCP,0)),"^",1)
S ZTSAVE("MDCP")="",ZTSAVE("MDCL")="",MDUSR=DUZ,ZTSAVE("MDUSR")="",ZTSAVE("MDSAP")=""
D ^%ZTLOAD K ZTSK
Q
GET ; Get existing parameter
N MDPAR,MDVAL
D GETLST^XPAR(.MDLST1,"SYS","MD CLINIC QUICK LIST")
D GETLST^XPAR(.MDLST2,"SYS","MD CLINICS WITH MULT PROC")
; Get Clinic Quick List
F MDLP=0:0 S MDLP=$O(MDLST1(MDLP)) Q:MDLP<1 S MDX1=+$P($G(MDLST1(MDLP)),"^",2) I +MDX1 D
. S MDX=$P($G(^MDS(702.01,MDX1,0)),"^",1) Q:MDX=""
. S MDY=+$G(MDLST1(MDLP)) Q:'MDY
. S MDY1=$$GET1^DIQ(44,MDY_",",.01)
. S ^TMP("MDOLD",$J,MDX,MDY1)=MDY_"^"_MDX1
; Get clinic with multiple procedures
F MDLP=0:0 S MDLP=$O(MDLST2(MDLP)) Q:MDLP<1 I +$G(MDLST2(MDLP)) S MDX=$P($G(^MDS(702.01,+$G(MDLST2(MDLP)),0)),"^",1) D
. S MDY=+$P($G(MDLST2(MDLP)),"^",2),MDY1=$$GET1^DIQ(44,MDY_",",.01)
. Q:$G(^TMP("MDOLD",$J,MDX,MDY1))'=""
. S ^TMP("MDOLD",$J,MDX,MDY1)=MDY_"^"_+$G(MDLST2(MDLP))
S MDPAR=$NA(^TMP("MDOLD",$J)),MDCTR=0 F S MDPAR=$Q(@MDPAR) Q:MDPAR="" Q:$QS(MDPAR,1)'="MDOLD" D
. S MDCTR=MDCTR+1,MDVAL=@MDPAR,MDVAL=$TR(MDVAL,"^",";")
. D EN^XPAR("SYS","MD CLINIC ASSOCIATION",MDCTR,MDVAL)
K ^TMP("MDOLD",$J)
Q
CLHELP ; Help Message for Clinic prompt
W !,"Only required, if appointments are scheduled for the procedure."
W !,"Enter the clinic used for scheduling the procedure."
I +MDCP,$D(^TMP("MDPARAM",$J)) D
.W ! S MDLP="" F S MDLP=$O(^TMP("MDPARAM",$J,$P($G(^MDS(702.01,+MDCP,0)),"^",1),MDLP)) Q:MDLP="" I MDLP'["None" W !,MDLP
W !
Q
HDR ; Parameter List Header
W @IOF,!!,"Procedure",?27,"Schedule Appt.",?55,"Clinic"
W !,"---------",?27,"--------------",?55,"------"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDWSETUP 9900 printed Apr 09, 2024@20:47:25 Page 2
MDWSETUP ; HOIFO/NCA - Auto Study Check-In Setup ;3/18/08 14:14
+1 ;;1.0;CLINICAL PROCEDURES;**14,11,37,45**;Apr 01, 2004;Build 1
EN1 ; [Procedure]
+1 ; This post conversion routine will place the Medicine Enter/Edit
+2 ; options out of order
+3 ; Reference IA # 2263 [Supported] XPAR parameter calls
+4 ; 10040 [Supported] Accessing Hospital Location file (#44)
+5 ; 10103 [Supported] XLFDT call
+6 ; 06/04/2014 KAM MD*1*37 Rem Ticket1007464 Clinical Proc Auto Check-in
+7 ; 09/21/2015 KAM MD*1*45 CA/SDM Ticket I5605614FY15 clinic editing
+8 ;
+9 NEW MDANS,MDAPT,MDAR,MDCL,MDCNOD,MDCP,MDCT,MDCTR,MDDEF,MDDFLT,MDERR,MDFLAG,MDFRST,MDLP,MDLAST,MDLST,MDLST1,MDLST2,MDNODE,MDNXT
+10 NEW MDPREC,MDS,MDSAP,MDSED,MDSEL,MDX,MDX1,MDX2,MDX3,MDY,MDY1
KILL ^TMP("MDOLD",$JOB)
+11 DO GETLST^XPAR(.MDLST1,"SYS","MD CLINIC ASSOCIATION")
IF '+$GET(MDLST1)
DO GET
+12 SET MDDEF=$$GET^XPAR("SYS","MD USE APPT WITH PROCEDURE",1)
SET MDDEF=$SELECT(+MDDEF:"YES",1:"NO")
+13 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Use Appointment with procedure? "
SET DIR("B")=MDDEF
SET DIR("?")="Enter either 'Y' or 'N'."
+14 SET DIR("?",1)="Default should be 'N' as most sites do not schedule procedures"
+15 SET DIR("?",2)="before the order is entered. Select 'Y' if the procedure appointment"
+16 SET DIR("?",3)="is scheduled before the order is entered and the ordering provider"
+17 SET DIR("?",4)="selects the appointment for the procedure."
+18 DO ^DIR
KILL DIR
if $DATA(DIRUT)!$DATA(DIROUT)!(Y<0)
QUIT
+19 ;D DEL^XPAR("SYS","MD USE APPT WITH PROCEDURE",1)
+20 DO EN^XPAR("SYS","MD USE APPT WITH PROCEDURE",1,0)
+21 DO GETLST^XPAR(.MDLST,"SYS","MD CHECK-IN PROCEDURE LIST")
+22 DO GETLST^XPAR(.MDLST1,"SYS","MD CLINIC ASSOCIATION")
+23 KILL ^TMP("MDPROC",$JOB),^TMP("MDPARAM",$JOB)
SET (MDCT,MDCTR,MDLAST)=0
+24 ; Get procedure parameter list
+25 FOR MDLP=0:0
SET MDLP=$ORDER(MDLST(MDLP))
if MDLP<1
QUIT
IF +$GET(MDLST(MDLP))
SET MDX=$PIECE($GET(^MDS(702.01,+$GET(MDLST(MDLP)),0)),"^",1)
Begin DoDot:1
+26 if MDX=""
QUIT
SET MDY=+$PIECE($GET(MDLST(MDLP)),"^",2)
+27 SET ^TMP("MDPROC",$JOB,MDX,+$GET(MDLST(MDLP)))=MDY_"^"_$SELECT(MDY=1:"Outpatient",MDY=2:"Inpatient",MDY=3:"Both",1:"None")
End DoDot:1
+28 ; Get Clinic Quick List
+29 FOR MDLP=0:0
SET MDLP=$ORDER(MDLST1(MDLP))
if MDLP<1
QUIT
SET MDX3=+$GET(MDLST1(MDLP))
SET MDX2=$PIECE($GET(MDLST1(MDLP)),"^",2)
SET MDX1=+$PIECE(MDX2,";",2)
IF +MDX1
Begin DoDot:1
+30 SET MDX=$PIECE($GET(^MDS(702.01,MDX1,0)),"^",1)
if MDX=""
QUIT
+31 SET MDY=+$PIECE(MDX2,";",1)
if 'MDY
QUIT
+32 SET MDCNOD=$GET(^TMP("MDPROC",$JOB,MDX,MDX1))
if MDCNOD=""
QUIT
+33 SET MDY1=$$GET1^DIQ(44,MDY_",",.01)
SET MDCTR=MDCTR+1
+34 if $GET(MDCTR(MDY))=""
SET MDCTR(MDY)=0
SET MDCTR(MDY)=MDCTR(MDY)+1
+35 SET ^TMP("MDPARAM",$JOB,MDX,MDY1)=MDX1_"^"_MDY_"^"_MDCNOD_"^"_MDX3
SET MDLAST=MDX3
End DoDot:1
+36 SET MDPREC=$NAME(^TMP("MDPROC",$JOB))
KILL MDLST,MDLST1
+37 FOR
SET MDPREC=$QUERY(@MDPREC)
if MDPREC=""
QUIT
if $QSUBSCRIPT(MDPREC,1)'="MDPROC"
QUIT
Begin DoDot:1
+38 IF '$DATA(^TMP("MDPARAM",$JOB,$QSUBSCRIPT(MDPREC,3)))
SET MDCTR=MDCTR+1
SET ^TMP("MDPARAM",$JOB,$QSUBSCRIPT(MDPREC,3),"None")=$QSUBSCRIPT(MDPREC,4)_"^^"_@MDPREC
End DoDot:1
QURY ; Query the procedure parameter list
+1 IF MDCTR<1
GOTO A1
+2 NEW MDN
SET MDPREC=$NAME(^TMP("MDPARAM",$JOB))
SET (MDANS,MDN)=""
DO HDR
+3 FOR
SET MDPREC=$QUERY(@MDPREC)
if MDPREC=""
QUIT
if $QSUBSCRIPT(MDPREC,1)'="MDPARAM"
QUIT
Begin DoDot:1
+4 if MDANS="^"
QUIT
+5 SET MDAPT=@MDPREC
SET MDAPT=$PIECE(MDAPT,"^",4)
+6 IF $Y>(IOSL-2)
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if Y
DO HDR
IF $DATA(DIRUT)!$DATA(DIROUT)!(Y<0)
SET MDANS="^"
QUIT
+7 IF MDN'=$QSUBSCRIPT(MDPREC,3)
WRITE !,$EXTRACT($QSUBSCRIPT(MDPREC,3),1,25),?27,MDAPT,?55,$EXTRACT($QSUBSCRIPT(MDPREC,4),1,25)
SET MDN=$QSUBSCRIPT(MDPREC,3)
QUIT
+8 WRITE !?55,$EXTRACT($QSUBSCRIPT(MDPREC,4),1,25)
End DoDot:1
A1 ; Ask for procedure parameter
+1 WRITE !!,"Procedure: "
READ X:DTIME
if '$TEST!("^"[X)
GOTO KIL
+2 IF X["?"
DO PHELP^MDWCHK
+3 KILL DIC
SET DIC="^MDS(702.01,"
SET DIC(0)="EQMZ"
SET DIC("S")="I +$P(^(0),U,9)>0"
+4 DO ^DIC
KILL DIC
if "^"[X!$DATA(DTOUT)
GOTO A1
if Y<1
GOTO A1
+5 SET MDSEL=Y
SET MDCP=+MDSEL
+6 if '$DATA(^TMP("MDPARAM",$JOB,Y(0,0)))
GOTO A2
+7 SET MDFRST=$ORDER(^TMP("MDPARAM",$JOB,Y(0,0),""))
if MDFRST=""
GOTO A2
+8 SET MDX1=$PIECE($GET(^TMP("MDPARAM",$JOB,Y(0,0),MDFRST)),"^",3)
+9 SET MDNXT=$ORDER(^TMP("MDPARAM",$JOB,Y(0,0),MDFRST))
SET MDDFLT=""
SET MDFLAG=0
+10 IF MDNXT=""
SET MDDFLT=$GET(^TMP("MDPARAM",$JOB,Y(0,0),MDFRST))
SET MDNODE=MDFRST
GOTO E1
+11 IF MDNXT'=""
Begin DoDot:1
+12 WRITE !
SET MDLP=""
SET MDCT=0
FOR
SET MDLP=$ORDER(^TMP("MDPARAM",$JOB,Y(0,0),MDLP))
if MDLP=""
QUIT
Begin DoDot:2
+13 SET MDCT=MDCT+1
WRITE !,MDCT_") ",Y(0,0)," ",MDLP
SET MDAR(MDCT)=MDLP
End DoDot:2
+14 WRITE !
KILL DIR
SET DIR(0)="NAO^1:"_MDCT
SET DIR("A")="Select 1-"_MDCT_": "
SET DIR("?")="Select from 1-"_MDCT
DO ^DIR
+15 IF X=""
SET MDSED=MDSEL
SET MDSAP=MDX1
SET MDFLAG=1
QUIT
+16 ;
+17 ;06/04/2014 KAM MD*1*37 Rem Ticket1007464
+18 ;modified the next line to better handle "^"
+19 ;
+20 ;K DIR G:$D(DIRUT)!$D(DIROUT)!(Y<1) KIL S MDS=Y
+21 ;
+22 ;09/21/2015 KAM MD*1*45 CA/SDM Ticket I5605614FY15
+23 ;modified next line to correct clinic editing issue
+24 ;K DIR D:$D(DIRUT)!$D(DIROUT)!(Y<1) KIL S MDFLAG=1 Q
+25 KILL DIR
SET MDS=Y
IF $DATA(DIRUT)!$DATA(DIROUT)!(Y<1)
DO KIL
SET MDFLAG=1
QUIT
+26 ;
+27 SET MDNODE=$GET(MDAR(MDS))
+28 SET MDDFLT=$GET(^TMP("MDPARAM",$JOB,$PIECE(MDSEL,"^",2),MDNODE))
End DoDot:1
if +MDFLAG
QUIT
E1 ; Edit the procedure
+1 WRITE !!,"Procedure: ",$PIECE(MDSEL,"^",2)_"// "
READ X:DTIME
if '$TEST!(X=U)
GOTO KIL
+2 IF X["?"!(X'="")&(X'="@")
WRITE !,"Hit Return to accept the procedure",!,"Enter ""@"" to delete the procedure.",!,"Enter a ""^"" will exit completely."
GOTO E1
+3 IF X="@"
Begin DoDot:1
+4 IF MDNXT=""
DO EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST",$PIECE(MDSEL,"^",2),"@")
+5 DO EN^XPAR("SYS","MD CLINIC ASSOCIATION",+$PIECE(MDDFLT,"^",5),"@")
+6 KILL ^TMP("MDPARAM",$JOB,$PIECE(MDSEL,"^",2),MDNODE)
+7 if +$PIECE(MDDFLT,"^",2)
SET MDCTR(+$PIECE(MDDFLT,"^",2))=MDCTR(+$PIECE(MDDFLT,"^",2))-1
+8 WRITE " ..Procedure deleted"
End DoDot:1
GOTO A1
+9 SET MDSED=MDSEL
E2 ; Ask whether appointment scheduled
+1 KILL DIR
SET DIR(0)="SA^0:None;1:Outpatient;2:Inpatient;3:Both"
SET DIR("A")="Schedule Appointment?: "
SET DIR("B")=+$PIECE(MDDFLT,"^",3)
+2 SET DIR("?")="^D CHELP^MDWCHK"
+3 DO ^DIR
KILL DIR
+4 if $DATA(DIRUT)!$DATA(DIROUT)!(Y<0)
GOTO KIL
SET MDSAP=Y
+5 IF $GET(MDDFLT)'=""
DO EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST",$PIECE(MDSEL,"^",2),"@")
+6 DO EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST","`"_+MDSED,+MDSAP)
+7 IF MDSAP'=+$PIECE(MDDFLT,"^",3)
SET MDLP=""
FOR
SET MDLP=$ORDER(^TMP("MDPARAM",$JOB,$PIECE(MDSED,"^",2),MDLP))
if MDLP=""
QUIT
SET MDX=$GET(^(MDLP))
IF $PIECE(MDX,"^",3)'=+MDSAP
Begin DoDot:1
+8 SET $PIECE(MDX,"^",3,4)=+MDSAP_"^"_$SELECT(MDSAP=1:"Outpatient",MDSAP=2:"Inpatient",MDSAP=3:"Both",1:"None")
+9 SET ^TMP("MDPARAM",$JOB,$PIECE(MDSED,"^",2),MDLP)=MDX
End DoDot:1
+10 IF MDNODE["None"
GOTO A3
E3 ; Edit the location
+1 WRITE !,"Clinic: ",MDNODE_"// "
READ X:DTIME
if '$TEST!(X=U)
GOTO KIL
+2 IF X["?"!(X'="")&(X'="@")
WRITE !,"Hit Return to accept the clinic",!,"Enter ""@"" to delete the clinic from the procedure.",!,"Enter a ""^"" will exit completely."
GOTO E3
+3 IF X=""
GOTO A4
+4 IF X="@"
Begin DoDot:1
+5 if +$PIECE(MDDFLT,"^",5)
DO EN^XPAR("SYS","MD CLINIC ASSOCIATION",+$PIECE(MDDFLT,"^",5),"@")
+6 if +$PIECE(MDDFLT,"^",2)
SET MDCTR(+$PIECE(MDDFLT,"^",2))=MDCTR(+$PIECE(MDDFLT,"^",2))-1
+7 KILL ^TMP("MDPARAM",$JOB,$PIECE(MDSEL,"^",2),MDNODE)
+8 IF $GET(MDNXT)=""
SET $PIECE(MDDFLT,"^",2)=""
SET ^TMP("MDPARAM",$JOB,$PIECE(MDSEL,"^",2),"None")=MDDFLT
+9 WRITE " ..Value deleted"
End DoDot:1
GOTO A4
+10 SET MDCL=+$PIECE(MDDFLT,"^",2)_"^"_MDNODE
+11 KILL MDCL,MDSEL
+12 GOTO A4
A2 ; Ask if site schedule appointments
+1 KILL DIR
SET DIR(0)="SA^0:None;1:Outpatient;2:Inpatient;3:Both"
SET DIR("A")="Schedule Appointment?: "
SET DIR("?")="^D CHELP^MDWCHK"
+2 DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)!$DATA(DIROUT)!(Y<0)
WRITE "...Procedure removed"
GOTO KIL
+4 SET MDSAP=Y
+5 DO EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST","`"_+MDSEL,+MDSAP)
+6 SET ^TMP("MDPARAM",$JOB,$PIECE(MDSEL,"^",2),"None")=+MDSEL_"^^"_MDSAP_"^"_$SELECT(MDSAP=1:"Outpatient",MDSAP=2:"Inpatient",MDSAP=3:"Both",1:"None")
+7 IF 'MDSAP
SET MDCL=""
DO TASK
GOTO A1
A3 ; Ask for clinic value
+1 WRITE !,"Clinic: "
READ X:DTIME
if '$TEST!(X=U)
GOTO KIL
+2 IF X["?"
DO CLHELP
+3 IF X=""
SET MDCL=""
if '+MDSAP
DO TASK
GOTO A1
+4 KILL DIC
SET DIC="^SC("
SET DIC(0)="EQMZ"
+5 DO ^DIC
KILL DIC
if "^"[X!$DATA(DTOUT)
GOTO A3
if Y<1
GOTO A3
+6 SET MDCL=Y
DO TASK
+7 KILL ^TMP("MDPARAM",$JOB,$PIECE(MDSEL,"^",2),"None")
+8 SET ^TMP("MDPARAM",$JOB,$PIECE(MDSEL,"^",2),$PIECE(MDCL,"^",2))=+MDSEL_"^"_+MDCL_"^"_MDSAP_"^"_$SELECT(MDSAP=1:"Outpatient",MDSAP=2:"Inpatient",MDSAP=3:"Both",1:"None")
+9 if $GET(MDCTR(+MDCL))=""
SET MDCTR(+MDCL)=0
SET MDCTR(+MDCL)=MDCTR(+MDCL)+1
SET MDLAST=MDLAST+1
+10 DO EN^XPAR("SYS","MD CLINIC ASSOCIATION",MDLAST,+MDCL_";"_+MDSEL)
A4 ; Ask for another Clinic
+1 KILL DIR
WRITE !
SET DIR(0)="YA"
SET DIR("A")="Enter another clinic for the same procedure? "
SET DIR("B")="NO"
SET DIR("?")="Enter either 'Y' or 'N', if you want to assign more than one clinic."
+2 DO ^DIR
KILL DIR
if $DATA(DIRUT)!$DATA(DIROUT)!(Y<0)
GOTO A4
+3 IF +Y
GOTO A3
+4 GOTO A1
KIL ; Clean Up TMP global arrays and exit
+1 KILL DIROUT,DIRUT,MDCL,MDSEL,X,Y
+2 KILL ^TMP("MDPROC",$JOB),^TMP("MDPARAM",$JOB)
+3 QUIT
TASK ; Queue a task to process previous requests
+1 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
SET ZTRTN="START^MDWCHK"
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT()
+2 SET ZTDESC="Check-In Studies for "_$PIECE($GET(^MDS(702.01,+MDCP,0)),"^",1)
+3 SET ZTSAVE("MDCP")=""
SET ZTSAVE("MDCL")=""
SET MDUSR=DUZ
SET ZTSAVE("MDUSR")=""
SET ZTSAVE("MDSAP")=""
+4 DO ^%ZTLOAD
KILL ZTSK
+5 QUIT
GET ; Get existing parameter
+1 NEW MDPAR,MDVAL
+2 DO GETLST^XPAR(.MDLST1,"SYS","MD CLINIC QUICK LIST")
+3 DO GETLST^XPAR(.MDLST2,"SYS","MD CLINICS WITH MULT PROC")
+4 ; Get Clinic Quick List
+5 FOR MDLP=0:0
SET MDLP=$ORDER(MDLST1(MDLP))
if MDLP<1
QUIT
SET MDX1=+$PIECE($GET(MDLST1(MDLP)),"^",2)
IF +MDX1
Begin DoDot:1
+6 SET MDX=$PIECE($GET(^MDS(702.01,MDX1,0)),"^",1)
if MDX=""
QUIT
+7 SET MDY=+$GET(MDLST1(MDLP))
if 'MDY
QUIT
+8 SET MDY1=$$GET1^DIQ(44,MDY_",",.01)
+9 SET ^TMP("MDOLD",$JOB,MDX,MDY1)=MDY_"^"_MDX1
End DoDot:1
+10 ; Get clinic with multiple procedures
+11 FOR MDLP=0:0
SET MDLP=$ORDER(MDLST2(MDLP))
if MDLP<1
QUIT
IF +$GET(MDLST2(MDLP))
SET MDX=$PIECE($GET(^MDS(702.01,+$GET(MDLST2(MDLP)),0)),"^",1)
Begin DoDot:1
+12 SET MDY=+$PIECE($GET(MDLST2(MDLP)),"^",2)
SET MDY1=$$GET1^DIQ(44,MDY_",",.01)
+13 if $GET(^TMP("MDOLD",$JOB,MDX,MDY1))'=""
QUIT
+14 SET ^TMP("MDOLD",$JOB,MDX,MDY1)=MDY_"^"_+$GET(MDLST2(MDLP))
End DoDot:1
+15 SET MDPAR=$NAME(^TMP("MDOLD",$JOB))
SET MDCTR=0
FOR
SET MDPAR=$QUERY(@MDPAR)
if MDPAR=""
QUIT
if $QSUBSCRIPT(MDPAR,1)'="MDOLD"
QUIT
Begin DoDot:1
+16 SET MDCTR=MDCTR+1
SET MDVAL=@MDPAR
SET MDVAL=$TRANSLATE(MDVAL,"^",";")
+17 DO EN^XPAR("SYS","MD CLINIC ASSOCIATION",MDCTR,MDVAL)
End DoDot:1
+18 KILL ^TMP("MDOLD",$JOB)
+19 QUIT
CLHELP ; Help Message for Clinic prompt
+1 WRITE !,"Only required, if appointments are scheduled for the procedure."
+2 WRITE !,"Enter the clinic used for scheduling the procedure."
+3 IF +MDCP
IF $DATA(^TMP("MDPARAM",$JOB))
Begin DoDot:1
+4 WRITE !
SET MDLP=""
FOR
SET MDLP=$ORDER(^TMP("MDPARAM",$JOB,$PIECE($GET(^MDS(702.01,+MDCP,0)),"^",1),MDLP))
if MDLP=""
QUIT
IF MDLP'["None"
WRITE !,MDLP
End DoDot:1
+5 WRITE !
+6 QUIT
HDR ; Parameter List Header
+1 WRITE @IOF,!!,"Procedure",?27,"Schedule Appt.",?55,"Clinic"
+2 WRITE !,"---------",?27,"--------------",?55,"------"
+3 QUIT
