source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDWSETUP.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 9.1 KB
Line 
1MDWSETUP ; HOIFO/NCA - Auto Study Check-In Setup ;12/13/07 22:39
2 ;;1.0;CLINICAL PROCEDURES;**14**;Apr 01, 2004;Build 20
3EN1 ; [Procedure]
4 ; This post conversion routine will place the Medicine Enter/Edit
5 ; options out of order
6 ; Reference IA # 2263 [Supported] XPAR parameter calls
7 ; 10040 [Supported] Accessing Hospital Location file (#44)
8 ; 10103 [Supported] XLFDT call
9 ;
10 N MDANS,MDAPT,MDAR,MDCL,MDCNOD,MDCP,MDCT,MDCTR,MDDEF,MDDFLT,MDERR,MDFLAG,MDFRST,MDLP,MDLST,MDLST1,MDLST2,MDNODE,MDNXT
11 N MDPREC,MDS,MDSAP,MDSED,MDSEL,MDX,MDX1,MDY,MDY1
12 S MDDEF=$$GET^XPAR("SYS","MD USE APPT WITH PROCEDURE",1),MDDEF=$S(+MDDEF:"YES",1:"NO")
13 D DEL^XPAR("SYS","MD USE APPT WITH PROCEDURE",1)
14 K DIR S DIR(0)="YA",DIR("A")="Use Appointment with procedure? ",DIR("B")=MDDEF,DIR("?")="Enter either 'Y' or 'N'."
15 S DIR("?",1)="Default should be 'N' as most sites do not schedule procedures"
16 S DIR("?",2)="before the order is entered. Select 'Y' if the procedure appointment"
17 S DIR("?",3)="is scheduled before the order is entered and the ordering provider"
18 S DIR("?",4)="selects the appointment for the procedure."
19 D ^DIR K DIR Q:$D(DIRUT)!$D(DIROUT)!(Y<0)
20 D EN^XPAR("SYS","MD USE APPT WITH PROCEDURE",1,Y)
21 D GETLST^XPAR(.MDLST,"SYS","MD CHECK-IN PROCEDURE LIST")
22 D GETLST^XPAR(.MDLST1,"SYS","MD CLINIC QUICK LIST")
23 D GETLST^XPAR(.MDLST2,"SYS","MD CLINICS WITH MULT PROC")
24 K ^TMP("MDPROC",$J),^TMP("MDPARAM",$J) S (MDCT,MDCTR)=0
25 ; Get procedure parameter list
26 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
27 . Q:MDX="" S MDY=+$P($G(MDLST(MDLP)),"^",2)
28 . S ^TMP("MDPROC",$J,MDX,+$G(MDLST(MDLP)))=MDY_"^"_$S(MDY=1:"Outpatient",MDY=2:"Inpatient",MDY=3:"Both",1:"None")
29 ; Get Clinic Quick List
30 F MDLP=0:0 S MDLP=$O(MDLST1(MDLP)) Q:MDLP<1 S MDX1=+$P($G(MDLST1(MDLP)),"^",2) I +MDX1 D
31 . S MDX=$P($G(^MDS(702.01,MDX1,0)),"^",1) Q:MDX=""
32 . S MDY=+$G(MDLST1(MDLP)) Q:'MDY
33 . S MDCNOD=$G(^TMP("MDPROC",$J,MDX,MDX1)) Q:MDCNOD=""
34 . S MDY1=$$GET1^DIQ(44,MDY_",",.01),MDCTR=MDCTR+1
35 . S:$G(MDCTR(MDY))="" MDCTR(MDY)=0 S MDCTR(MDY)=MDCTR(MDY)+1
36 . S ^TMP("MDPARAM",$J,MDX,MDY1)=MDX1_"^"_MDY_"^"_MDCNOD
37 ; Get clinic with multiple procedures
38 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
39 . S MDY=$P($G(MDLST2(MDLP)),"^",2),MDY1=$$GET1^DIQ(44,MDY_",",.01)
40 . Q:$G(^TMP("MDPARAM",$J,MDX,MDY1))'=""
41 . S MDCNOD=$G(^TMP("MDPROC",$J,MDX,+$G(MDLST2(MDLP))))
42 . S:MDCNOD="" MDCNOD=0_"^None"
43 . S ^TMP("MDPARAM",$J,MDX,MDY1)=+$G(MDLST2(MDLP))_"^"_MDY_"^"_MDCNOD
44 . S:$G(MDCTR(MDY))="" MDCTR(MDY)=0 S MDCTR=MDCTR+1,MDCTR(MDY)=MDCTR(MDY)+1
45 S MDPREC=$NA(^TMP("MDPROC",$J)) K MDLST,MDLST1,MDLST2
46 F S MDPREC=$Q(@MDPREC) Q:MDPREC="" Q:$QS(MDPREC,1)'="MDPROC" D
47 . I '$D(^TMP("MDPARAM",$J,$QS(MDPREC,3))) S MDCTR=MDCTR+1,^TMP("MDPARAM",$J,$QS(MDPREC,3),"None")=$QS(MDPREC,4)_"^^"_@MDPREC
48QURY ; Query the procedure parameter list
49 I MDCTR<1 G A1
50 N MDN S MDPREC=$NA(^TMP("MDPARAM",$J)),(MDANS,MDN)="" D HDR
51 F S MDPREC=$Q(@MDPREC) Q:MDPREC="" Q:$QS(MDPREC,1)'="MDPARAM" D
52 . Q:MDANS="^"
53 . S MDAPT=@MDPREC,MDAPT=$P(MDAPT,"^",4)
54 . 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
55 . 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
56 . W !?55,$E($QS(MDPREC,4),1,25)
57A1 ; Ask for procedure parameter
58 W !!,"Procedure: " R X:DTIME G:'$T!("^"[X) KIL
59 I X["?" D PHELP^MDWCHK
60 K DIC S DIC="^MDS(702.01,",DIC(0)="EQMZ",DIC("S")="I +$P(^(0),U,9)>0"
61 D ^DIC K DIC G A1:"^"[X!$D(DTOUT),A1:Y<1
62 S MDSEL=Y,MDCP=+MDSEL
63 G:'$D(^TMP("MDPARAM",$J,Y(0,0))) A2
64 S MDFRST=$O(^TMP("MDPARAM",$J,Y(0,0),"")) G:MDFRST="" A2
65 S MDX1=$P($G(^TMP("MDPARAM",$J,Y(0,0),MDFRST)),"^",3)
66 S MDNXT=$O(^TMP("MDPARAM",$J,Y(0,0),MDFRST)),MDDFLT="",MDFLAG=0
67 I MDNXT="" S MDDFLT=$G(^TMP("MDPARAM",$J,Y(0,0),MDFRST)),MDNODE=MDFRST G E1
68 I MDNXT'="" D Q:+MDFLAG
69 . W ! S MDLP="",MDCT=0 F S MDLP=$O(^TMP("MDPARAM",$J,Y(0,0),MDLP)) Q:MDLP="" D
70 . . S MDCT=MDCT+1 W !,MDCT_") ",Y(0,0)," ",MDLP S MDAR(MDCT)=MDLP
71 . W ! K DIR S DIR(0)="NAO^1:"_MDCT,DIR("A")="Select 1-"_MDCT_": ",DIR("?")="Select from 1-"_MDCT D ^DIR
72 . I X="" S MDSED=MDSEL,MDSAP=MDX1,MDFLAG=1 Q
73 . K DIR G:$D(DIRUT)!$D(DIROUT)!(Y<1) KIL S MDS=Y
74 . S MDNODE=$G(MDAR(MDS))
75 . S MDDFLT=$G(^TMP("MDPARAM",$J,$P(MDSEL,"^",2),MDNODE))
76E1 ; Edit the procedure
77 W !!,"Procedure: ",$P(MDSEL,"^",2)_"// " R X:DTIME G:'$T!(X=U) KIL
78 I X["?"!(X'="")&(X'="@") W !,"Hit Return to accept the procedure",!,"Enter ""@"" to delete the procedure.",!,"Enter a ""^"" will exit completely." G E1
79 I X="@" D G A1
80 . I MDNXT="" D EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST",$P(MDSEL,"^",2),"@")
81 . D:+$G(MDCTR(+$P(MDDFLT,"^",2)))>1 EN^XPAR("SYS","MD CLINICS WITH MULT PROC","`"_$P(MDSEL,"^",1),"@")
82 . D:MDNODE'["None" EN^XPAR("SYS","MD CLINIC QUICK LIST","`"_+$P(MDDFLT,"^",2),"@")
83 . K MDLST2 D GETLST^XPAR(.MDLST2,"SYS","MD CLINICS WITH MULT PROC")
84 . S MDLP="" F S MDLP=$O(MDLST2(MDLP)) Q:MDLP="" I +$G(MDLST2(MDLP))=+$P(MDSEL,"^",1) D
85 . . I $P($G(MDLST2(MDLP)),"^",2)=+$P(MDDFLT,"^",2) D EN^XPAR("SYS","MD CLINICS WITH MULT PROC","`"_+$P(MDSEL,"^",1),"@")
86 . K ^TMP("MDPARAM",$J,$P(MDSEL,"^",2),MDNODE)
87 . S:+$P(MDDFLT,"^",2) MDCTR(+$P(MDDFLT,"^",2))=MDCTR(+$P(MDDFLT,"^",2))-1
88 . W " ..Procedure deleted"
89 S MDSED=MDSEL
90E2 ; Ask whether appointment scheduled
91 K DIR S DIR(0)="SA^0:None;1:Outpatient;2:Inpatient;3:Both",DIR("A")="Schedule Appointment?: ",DIR("B")=+$P(MDDFLT,"^",3)
92 S DIR("?")="^D CHELP^MDWCHK"
93 D ^DIR K DIR
94 G:$D(DIRUT)!$D(DIROUT)!(Y<0) KIL S MDSAP=Y
95 I $G(MDDFLT)'="" D EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST",$P(MDSEL,"^",2),"@")
96 D EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST","`"_+MDSED,+MDSAP)
97 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
98 . S $P(MDX,"^",3,4)=+MDSAP_"^"_$S(MDSAP=1:"Outpatient",MDSAP=2:"Inpatient",MDSAP=3:"Both",1:"None")
99 . S ^TMP("MDPARAM",$J,$P(MDSED,"^",2),MDLP)=MDX
100 I MDNODE["None" G A3
101E3 ; Edit the location
102 W !,"Clinic: ",MDNODE_"// " R X:DTIME G:'$T!(X=U) KIL
103 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
104 I X="" G A4
105 I X="@" D G A4
106 . D EN^XPAR("SYS","MD CLINIC QUICK LIST","`"_+$P(MDDFLT,"^",2),"@")
107 . S:+$P(MDDFLT,"^",2) MDCTR(+$P(MDDFLT,"^",2))=MDCTR(+$P(MDDFLT,"^",2))-1
108 . K MDLST2 D GETLST^XPAR(.MDLST2,"SYS","MD CLINICS WITH MULT PROC")
109 . S MDLP="" F S MDLP=$O(MDLST2(MDLP)) Q:MDLP="" I +$G(MDLST2(MDLP))=+$P(MDSEL,"^",1) D
110 . . I $P($G(MDLST2(MDLP)),"^",2)=+$P(MDDFLT,"^",2) D EN^XPAR("SYS","MD CLINICS WITH MULT PROC","`"_+$P(MDSEL,"^",1),"@")
111 . K ^TMP("MDPARAM",$J,$P(MDSEL,"^",2),MDNODE),MDLST2
112 . I $G(MDNXT)="" S $P(MDDFLT,"^",2)="",^TMP("MDPARAM",$J,$P(MDSEL,"^",2),"None")=MDDFLT
113 . W " ..Value deleted"
114 S MDCL=+$P(MDDFLT,"^",2)_"^"_MDNODE
115 K MDCL,MDSEL
116 G A4
117A2 ; Ask if site schedule appointments
118 K DIR S DIR(0)="SA^0:None;1:Outpatient;2:Inpatient;3:Both",DIR("A")="Schedule Appointment?: ",DIR("?")="^D CHELP^MDWCHK"
119 D ^DIR K DIR
120 I $D(DIRUT)!$D(DIROUT)!(Y<0) W "...Procedure removed" G KIL
121 S MDSAP=Y
122 D EN^XPAR("SYS","MD CHECK-IN PROCEDURE LIST","`"_+MDSEL,+MDSAP)
123 S ^TMP("MDPARAM",$J,$P(MDSEL,"^",2),"None")=+MDSEL_"^^"_MDSAP_"^"_$S(MDSAP=1:"Outpatient",MDSAP=2:"Inpatient",MDSAP=3:"Both",1:"None")
124 I 'MDSAP S MDCL="" D TASK G A1
125A3 ; Ask for clinic value
126 W !,"Clinic: " R X:DTIME G:'$T!(X=U) KIL
127 I X["?" D CLHELP
128 I X="" S MDCL="" D:'+MDSAP TASK G A1
129 K DIC S DIC="^SC(",DIC(0)="EQMZ"
130 D ^DIC K DIC G A3:"^"[X!$D(DTOUT),A3:Y<1
131 S MDCL=Y D TASK
132 K ^TMP("MDPARAM",$J,$P(MDSEL,"^",2),"None")
133 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")
134 S:$G(MDCTR(+MDCL))="" MDCTR(+MDCL)=0 S MDCTR(+MDCL)=MDCTR(+MDCL)+1
135 I +$G(MDCTR(+MDCL))>1 D EN^XPAR("SYS","MD CLINICS WITH MULT PROC","`"_+MDSEL,"`"_+MDCL) G A4
136 D EN^XPAR("SYS","MD CLINIC QUICK LIST","`"_+MDCL,"`"_+MDSEL)
137A4 ; Ask for another Clinic
138 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."
139 D ^DIR K DIR G:$D(DIRUT)!$D(DIROUT)!(Y<0) A4
140 I +Y G A3
141 G A1
142KIL ; Clean Up TMP global arrays and exit
143 K DIROUT,DIRUT,MDCL,MDSEL,X,Y
144 K ^TMP("MDPROC",$J),^TMP("MDPARAM",$J)
145 Q
146TASK ; Queue a task to process previous requests
147 K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE S ZTRTN="START^MDWCHK",ZTREQ="@",ZTSAVE("ZTREQ")="",ZTIO="",ZTDTH=$$NOW^XLFDT()
148 S ZTDESC="Check-In Studies for "_$P($G(^MDS(702.01,+MDCP,0)),"^",1)
149 S ZTSAVE("MDCP")="",ZTSAVE("MDCL")="",MDUSR=DUZ,ZTSAVE("MDUSR")="",ZTSAVE("MDSAP")=""
150 D ^%ZTLOAD K ZTSK
151 Q
152CLHELP ; Help Message for Clinic prompt
153 W !,"Only required, if appointments are scheduled for the procedure."
154 W !,"Enter the clinic used for scheduling the procedure."
155 I +MDCP,$D(^TMP("MDPARAM",$J)) D
156 .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
157 W !
158 Q
159HDR ; Parameter List Header
160 W @IOF,!!,"Procedure",?27,"Schedule Appt.",?55,"Clinic"
161 W !,"---------",?27,"--------------",?55,"------"
162 Q
Note: See TracBrowser for help on using the repository browser.