source: WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDWCHK.m@ 691

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

initial load of WorldVistAEHR
File size: 3.6 KB
RevLine 
[613]1MDWCHK ; HOIFO/NCA - Create CP Studies for Existing Procedures ;12/13/07 15:52
2 ;;1.0;CLINICAL PROCEDURES;**14**;Apr 01,2004;Build 20
3 ; Reference IA #10103 [Supported] XLFDT call
4 ; 10035 [Supported] Access DPT file (#2)
5 ; 10061 [Supported] VADPT call
6 ; 5062 [Private] Use of GMR(123,"ACP"
7 ;
8START ; Convert procedure to procedures.
9 N MDAP,MDCPR,MDFD,MDFDA,MDFLG,MDFR,MDHEMO,MDHL7,MDHOLD,MDIEN,MDIENS,MDINST,MDJ1,MDL,MDLP,MDMAXD,MDNDT,MDNOW,MDNVS,MDP,MDST,MDX,MDY
10 Q:$G(MDCP)=""
11 Q:$G(MDUSR)=""
12 N MDY,X,Y,MDIEN,MDINST K ^TMP("MDPAT",$J) S MDMAXD=DT+.24,MDP=MDCP,MDFLG=0,MDAP=""
13 S MDY=+$G(MDSAP)
14 S MDL="" F S MDL=$O(^GMR(123,"ACP",MDP,MDL)) Q:MDL<1 S MDJ1=0 F S MDJ1=$O(^GMR(123,"ACP",MDP,MDL,MDJ1)) Q:MDJ1<1 D
15 .Q:$D(^TMP("MDPAT",$J,MDL))
16 .S MDFD=$O(^MDD(702,"ACON",+MDJ1,0)) Q:+MDFD>0
17 .S MDST=$$GET1^DIQ(123,+MDJ1_",",8,"E")
18 .Q:MDST'["PENDING"&(MDST'["ACTIVE")&(MDST'["SCHEDULED")
19 .S ^TMP("MDPAT",$J,MDL)="",MDAP=""
20 .S:'MDY MDAP=$$NOW^XLFDT()_"^"_$P($G(^MDS(702.01,+MDP,0)),"^",5)
21 .I $G(^DPT(MDL,.1))'=""&(MDY=1) S MDAP=$$NOW^XLFDT()_"^"_$P($G(^MDS(702.01,+MDP,0)),"^",5) Q:$P($G(^MDS(702.01,+MDP,0)),"^",5)=""
22 .I $G(^DPT(MDL,.1))=""&(MDY=2) S MDAP=$$NOW^XLFDT()_"^"_$P($G(^MDS(702.01,+MDP,0)),"^",5) Q:$P($G(^MDS(702.01,+MDP,0)),"^",5)=""
23 .I MDAP=""&(+$G(MDCL)>0) S MDAP=$$GETAPPT(MDL,MDCL)
24 .Q:'+MDAP
25 .S MDHEMO=$P($G(^MDS(702.01,+MDCP,0)),"^",6)
26 .S MDNDT=$S($P(MDAP,"^",1)="":$$NOW^XLFDT(),1:$P(MDAP,"^",1))
27 .S MDNVS=$S($P(MDAP,"^",1)="":$$NOW^XLFDT(),1:"A;"_$P(MDAP,"^",1)_";"_$P(MDAP,"^",2))
28 .I $E(MDAP,1)="A" Q:$P(MDAP,";",3)=""
29 .K MDFDA,MDIEN
30 .S MDFDA(702,"+1,",.01)=MDL
31 .S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
32 .S MDFDA(702,"+1,",.03)=MDUSR
33 .S MDFDA(702,"+1,",.04)=MDCP
34 .S MDFDA(702,"+1,",.05)=MDJ1
35 .S MDFDA(702,"+1,",.07)=MDNVS
36 .S MDINST=+$$GINST^MDWORSR(MDCP) Q:'MDINST
37 .S:MDNDT>MDMAXD MDFDA(702,"+1,",.09)=0
38 .S MDFDA(702,"+1,",.11)=+MDINST
39 .S MDFDA(702,"+1,",.14)=MDNDT
40 .D UPDATE^DIE("","MDFDA","MDIEN","MDERR") K MDFDA
41 .Q:MDNDT>MDMAXD
42 .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)=$S(MDNOW>MDNDT:MDNDT,1:MDNOW)
43 .S MDHL7=$$SUB^MDHL7B(MDIEN(1))
44 .I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
45 .I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
46 .D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
47 .Q:'+$G(MDIENS)
48 .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")
49 .Q
50 K ^TMP("MDPAT",$J)
51 Q
52GETAPPT(MDPAT,MDDA) ; Get appointment
53 N DFN,MDALP,MDARES K ^UTILITY("VASD",$J) S DFN=MDPAT
54 S X1=DT,X2=365 D C^%DTC S VASD("T")=X+.24,VASD("F")=DT,VASD("W")="129",VASD("C",+MDDA)=+MDDA D SDA^VADPT
55 S MDARES=0 F MDALP=0:0 S MDALP=$O(^UTILITY("VASD",$J,MDALP)) Q:MDALP<1 S MDARES=$G(^(MDALP,"I")) Q
56 K ^UTILITY("VASD",$J),VASD,X1,X2,X
57 Q MDARES
58CHELP ; Help Message for the Schedule Appointment prompt
59 W !!,"REQUIRED field for the procedure to have auto CP study check-in."
60 W !,"Enter a ""^"" will exit completely."
61 W !!,"Enter 0 if you do not schedule appointments."
62 W !," 1 if you only schedule appointments for outpatients."
63 W !," 2 if you only schedule appointments for inpatients."
64 W !," 3 if you schedule appointments for both 1 and 2."
65 Q
66PHELP ; Help Message for Procedure prompt
67 W !,"Enter a CP Definition for the procedure to"
68 W !,"have auto CP study check-in.",!
69 K MDLST D GETLST^XPAR(.MDLST,"SYS","MD CHECK-IN PROCEDURE LIST")
70 F MDLP=0:0 S MDLP=$O(MDLST(MDLP)) Q:MDLP<1 I +$G(MDLST(MDLP)) W !,$P($G(^MDS(702.01,+MDLST(MDLP),0)),"^",1)
71 K MDLST
72 Q
Note: See TracBrowser for help on using the repository browser.