163 lines
9.1 KiB
Mathematica
163 lines
9.1 KiB
Mathematica
MDWSETUP ; HOIFO/NCA - Auto Study Check-In Setup ;12/13/07 22:39
|
|
;;1.0;CLINICAL PROCEDURES;**14**;Apr 01, 2004;Build 20
|
|
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
|
|
;
|
|
N MDANS,MDAPT,MDAR,MDCL,MDCNOD,MDCP,MDCT,MDCTR,MDDEF,MDDFLT,MDERR,MDFLAG,MDFRST,MDLP,MDLST,MDLST1,MDLST2,MDNODE,MDNXT
|
|
N MDPREC,MDS,MDSAP,MDSED,MDSEL,MDX,MDX1,MDY,MDY1
|
|
S MDDEF=$$GET^XPAR("SYS","MD USE APPT WITH PROCEDURE",1),MDDEF=$S(+MDDEF:"YES",1:"NO")
|
|
D DEL^XPAR("SYS","MD USE APPT WITH PROCEDURE",1)
|
|
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 EN^XPAR("SYS","MD USE APPT WITH PROCEDURE",1,Y)
|
|
D GETLST^XPAR(.MDLST,"SYS","MD CHECK-IN PROCEDURE LIST")
|
|
D GETLST^XPAR(.MDLST1,"SYS","MD CLINIC QUICK LIST")
|
|
D GETLST^XPAR(.MDLST2,"SYS","MD CLINICS WITH MULT PROC")
|
|
K ^TMP("MDPROC",$J),^TMP("MDPARAM",$J) S (MDCT,MDCTR)=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 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 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
|
|
; 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("MDPARAM",$J,MDX,MDY1))'=""
|
|
. S MDCNOD=$G(^TMP("MDPROC",$J,MDX,+$G(MDLST2(MDLP))))
|
|
. S:MDCNOD="" MDCNOD=0_"^None"
|
|
. S ^TMP("MDPARAM",$J,MDX,MDY1)=+$G(MDLST2(MDLP))_"^"_MDY_"^"_MDCNOD
|
|
. S:$G(MDCTR(MDY))="" MDCTR(MDY)=0 S MDCTR=MDCTR+1,MDCTR(MDY)=MDCTR(MDY)+1
|
|
S MDPREC=$NA(^TMP("MDPROC",$J)) K MDLST,MDLST1,MDLST2
|
|
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
|
|
. K DIR G:$D(DIRUT)!$D(DIROUT)!(Y<1) KIL S MDS=Y
|
|
. 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:+$G(MDCTR(+$P(MDDFLT,"^",2)))>1 EN^XPAR("SYS","MD CLINICS WITH MULT PROC","`"_$P(MDSEL,"^",1),"@")
|
|
. D:MDNODE'["None" EN^XPAR("SYS","MD CLINIC QUICK LIST","`"_+$P(MDDFLT,"^",2),"@")
|
|
. K MDLST2 D GETLST^XPAR(.MDLST2,"SYS","MD CLINICS WITH MULT PROC")
|
|
. S MDLP="" F S MDLP=$O(MDLST2(MDLP)) Q:MDLP="" I +$G(MDLST2(MDLP))=+$P(MDSEL,"^",1) D
|
|
. . I $P($G(MDLST2(MDLP)),"^",2)=+$P(MDDFLT,"^",2) D EN^XPAR("SYS","MD CLINICS WITH MULT PROC","`"_+$P(MDSEL,"^",1),"@")
|
|
. 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 EN^XPAR("SYS","MD CLINIC QUICK LIST","`"_+$P(MDDFLT,"^",2),"@")
|
|
. S:+$P(MDDFLT,"^",2) MDCTR(+$P(MDDFLT,"^",2))=MDCTR(+$P(MDDFLT,"^",2))-1
|
|
. K MDLST2 D GETLST^XPAR(.MDLST2,"SYS","MD CLINICS WITH MULT PROC")
|
|
. S MDLP="" F S MDLP=$O(MDLST2(MDLP)) Q:MDLP="" I +$G(MDLST2(MDLP))=+$P(MDSEL,"^",1) D
|
|
. . I $P($G(MDLST2(MDLP)),"^",2)=+$P(MDDFLT,"^",2) D EN^XPAR("SYS","MD CLINICS WITH MULT PROC","`"_+$P(MDSEL,"^",1),"@")
|
|
. K ^TMP("MDPARAM",$J,$P(MDSEL,"^",2),MDNODE),MDLST2
|
|
. 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
|
|
I +$G(MDCTR(+MDCL))>1 D EN^XPAR("SYS","MD CLINICS WITH MULT PROC","`"_+MDSEL,"`"_+MDCL) G A4
|
|
D EN^XPAR("SYS","MD CLINIC QUICK LIST","`"_+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
|
|
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
|