source: FOIAVistA/tag/r/CLINICAL_PROCEDURES-MD/MDWSETUP.m@ 628

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