MDWCHK ; HOIFO/NCA - Create CP Studies for Existing Procedures ;12/13/07 15:52
;;1.0;CLINICAL PROCEDURES;**14**;Apr 01,2004;Build 20
; Reference IA #10103 [Supported] XLFDT call
; 10035 [Supported] Access DPT file (#2)
; 10061 [Supported] VADPT call
; 5062 [Private] Use of GMR(123,"ACP"
;
START ; Convert procedure to procedures.
N MDAP,MDCPR,MDFD,MDFDA,MDFLG,MDFR,MDHEMO,MDHL7,MDHOLD,MDIEN,MDIENS,MDINST,MDJ1,MDL,MDLP,MDMAXD,MDNDT,MDNOW,MDNVS,MDP,MDST,MDX,MDY
Q:$G(MDCP)=""
Q:$G(MDUSR)=""
N MDY,X,Y,MDIEN,MDINST K ^TMP("MDPAT",$J) S MDMAXD=DT+.24,MDP=MDCP,MDFLG=0,MDAP=""
S MDY=+$G(MDSAP)
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
.Q:$D(^TMP("MDPAT",$J,MDL))
.S MDFD=$O(^MDD(702,"ACON",+MDJ1,0)) Q:+MDFD>0
.S MDST=$$GET1^DIQ(123,+MDJ1_",",8,"E")
.Q:MDST'["PENDING"&(MDST'["ACTIVE")&(MDST'["SCHEDULED")
.S ^TMP("MDPAT",$J,MDL)="",MDAP=""
.S:'MDY MDAP=$$NOW^XLFDT()_"^"_$P($G(^MDS(702.01,+MDP,0)),"^",5)
.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)=""
.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)=""
.I MDAP=""&(+$G(MDCL)>0) S MDAP=$$GETAPPT(MDL,MDCL)
.Q:'+MDAP
.S MDHEMO=$P($G(^MDS(702.01,+MDCP,0)),"^",6)
.S MDNDT=$S($P(MDAP,"^",1)="":$$NOW^XLFDT(),1:$P(MDAP,"^",1))
.S MDNVS=$S($P(MDAP,"^",1)="":$$NOW^XLFDT(),1:"A;"_$P(MDAP,"^",1)_";"_$P(MDAP,"^",2))
.I $E(MDAP,1)="A" Q:$P(MDAP,";",3)=""
.K MDFDA,MDIEN
.S MDFDA(702,"+1,",.01)=MDL
.S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
.S MDFDA(702,"+1,",.03)=MDUSR
.S MDFDA(702,"+1,",.04)=MDCP
.S MDFDA(702,"+1,",.05)=MDJ1
.S MDFDA(702,"+1,",.07)=MDNVS
.S MDINST=+$$GINST^MDWORSR(MDCP) Q:'MDINST
.S:MDNDT>MDMAXD MDFDA(702,"+1,",.09)=0
.S MDFDA(702,"+1,",.11)=+MDINST
.S MDFDA(702,"+1,",.14)=MDNDT
.D UPDATE^DIE("","MDFDA","MDIEN","MDERR") K MDFDA
.Q:MDNDT>MDMAXD
.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)
.S MDHL7=$$SUB^MDHL7B(MDIEN(1))
.I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
.I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
.D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
.Q:'+$G(MDIENS)
.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")
.Q
K ^TMP("MDPAT",$J)
Q
GETAPPT(MDPAT,MDDA) ; Get appointment
N DFN,MDALP,MDARES K ^UTILITY("VASD",$J) S DFN=MDPAT
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
S MDARES=0 F MDALP=0:0 S MDALP=$O(^UTILITY("VASD",$J,MDALP)) Q:MDALP<1 S MDARES=$G(^(MDALP,"I")) Q
K ^UTILITY("VASD",$J),VASD,X1,X2,X
Q MDARES
CHELP ; Help Message for the Schedule Appointment prompt
W !!,"REQUIRED field for the procedure to have auto CP study check-in."
W !,"Enter a ""^"" will exit completely."
W !!,"Enter 0 if you do not schedule appointments."
W !," 1 if you only schedule appointments for outpatients."
W !," 2 if you only schedule appointments for inpatients."
W !," 3 if you schedule appointments for both 1 and 2."
Q
PHELP ; Help Message for Procedure prompt
W !,"Enter a CP Definition for the procedure to"
W !,"have auto CP study check-in.",!
K MDLST D GETLST^XPAR(.MDLST,"SYS","MD CHECK-IN PROCEDURE LIST")
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)
K MDLST
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDWCHK 3758 printed Sep 23, 2025@19:20:30 Page 2
MDWCHK ; HOIFO/NCA - Create CP Studies for Existing Procedures ;12/13/07 15:52
+1 ;;1.0;CLINICAL PROCEDURES;**14**;Apr 01,2004;Build 20
+2 ; Reference IA #10103 [Supported] XLFDT call
+3 ; 10035 [Supported] Access DPT file (#2)
+4 ; 10061 [Supported] VADPT call
+5 ; 5062 [Private] Use of GMR(123,"ACP"
+6 ;
START ; Convert procedure to procedures.
+1 NEW MDAP,MDCPR,MDFD,MDFDA,MDFLG,MDFR,MDHEMO,MDHL7,MDHOLD,MDIEN,MDIENS,MDINST,MDJ1,MDL,MDLP,MDMAXD,MDNDT,MDNOW,MDNVS,MDP,MDST,MDX,MDY
+2 if $GET(MDCP)=""
QUIT
+3 if $GET(MDUSR)=""
QUIT
+4 NEW MDY,X,Y,MDIEN,MDINST
KILL ^TMP("MDPAT",$JOB)
SET MDMAXD=DT+.24
SET MDP=MDCP
SET MDFLG=0
SET MDAP=""
+5 SET MDY=+$GET(MDSAP)
+6 SET MDL=""
FOR
SET MDL=$ORDER(^GMR(123,"ACP",MDP,MDL))
if MDL<1
QUIT
SET MDJ1=0
FOR
SET MDJ1=$ORDER(^GMR(123,"ACP",MDP,MDL,MDJ1))
if MDJ1<1
QUIT
Begin DoDot:1
+7 if $DATA(^TMP("MDPAT",$JOB,MDL))
QUIT
+8 SET MDFD=$ORDER(^MDD(702,"ACON",+MDJ1,0))
if +MDFD>0
QUIT
+9 SET MDST=$$GET1^DIQ(123,+MDJ1_",",8,"E")
+10 if MDST'["PENDING"&(MDST'["ACTIVE")&(MDST'["SCHEDULED")
QUIT
+11 SET ^TMP("MDPAT",$JOB,MDL)=""
SET MDAP=""
+12 if 'MDY
SET MDAP=$$NOW^XLFDT()_"^"_$PIECE($GET(^MDS(702.01,+MDP,0)),"^",5)
+13 IF $GET(^DPT(MDL,.1))'=""&(MDY=1)
SET MDAP=$$NOW^XLFDT()_"^"_$PIECE($GET(^MDS(702.01,+MDP,0)),"^",5)
if $PIECE($GET(^MDS(702.01,+MDP,0)),"^",5)=""
QUIT
+14 IF $GET(^DPT(MDL,.1))=""&(MDY=2)
SET MDAP=$$NOW^XLFDT()_"^"_$PIECE($GET(^MDS(702.01,+MDP,0)),"^",5)
if $PIECE($GET(^MDS(702.01,+MDP,0)),"^",5)=""
QUIT
+15 IF MDAP=""&(+$GET(MDCL)>0)
SET MDAP=$$GETAPPT(MDL,MDCL)
+16 if '+MDAP
QUIT
+17 SET MDHEMO=$PIECE($GET(^MDS(702.01,+MDCP,0)),"^",6)
+18 SET MDNDT=$SELECT($PIECE(MDAP,"^",1)="":$$NOW^XLFDT(),1:$PIECE(MDAP,"^",1))
+19 SET MDNVS=$SELECT($PIECE(MDAP,"^",1)="":$$NOW^XLFDT(),1:"A;"_$PIECE(MDAP,"^",1)_";"_$PIECE(MDAP,"^",2))
+20 IF $EXTRACT(MDAP,1)="A"
if $PIECE(MDAP,";",3)=""
QUIT
+21 KILL MDFDA,MDIEN
+22 SET MDFDA(702,"+1,",.01)=MDL
+23 SET MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
+24 SET MDFDA(702,"+1,",.03)=MDUSR
+25 SET MDFDA(702,"+1,",.04)=MDCP
+26 SET MDFDA(702,"+1,",.05)=MDJ1
+27 SET MDFDA(702,"+1,",.07)=MDNVS
+28 SET MDINST=+$$GINST^MDWORSR(MDCP)
if 'MDINST
QUIT
+29 if MDNDT>MDMAXD
SET MDFDA(702,"+1,",.09)=0
+30 SET MDFDA(702,"+1,",.11)=+MDINST
+31 SET MDFDA(702,"+1,",.14)=MDNDT
+32 DO UPDATE^DIE("","MDFDA","MDIEN","MDERR")
KILL MDFDA
+33 if MDNDT>MDMAXD
QUIT
+34 SET MDIENS=MDIEN(1)_","
IF +MDHEMO=2
SET MDHOLD=$PIECE($GET(^MDD(702,MDIEN(1),0)),"^",7)
SET MDNOW=$$NOW^XLFDT()
SET $PIECE(^MDD(702,MDIEN(1),0),"^",7)=$SELECT(MDNOW>MDNDT:MDNDT,1:MDNOW)
+35 SET MDHL7=$$SUB^MDHL7B(MDIEN(1))
+36 IF +MDHL7=-1
SET MDFDA(702,MDIENS,.09)=2
SET MDFDA(702,MDIENS,.08)=$PIECE(MDHL7,U,2)
+37 IF +MDHL7=1
SET MDFDA(702,MDIENS,.09)=5
SET MDFDA(702,MDIENS,.08)=""
+38 if $DATA(MDFDA)
DO FILE^DIE("","MDFDA","MDERR")
+39 if '+$GET(MDIENS)
QUIT
+40 IF MDHEMO=2
DO CP^MDKUTL(+MDIENS)
KILL MDFDA
if $GET(MDHOLD)'=""
SET MDFDA(702,+MDIENS_",",.07)=MDHOLD
SET MDFDA(702,+MDIENS_",",.09)=5
DO FILE^DIE("","MDFDA","MDERR")
+41 QUIT
End DoDot:1
+42 KILL ^TMP("MDPAT",$JOB)
+43 QUIT
GETAPPT(MDPAT,MDDA) ; Get appointment
+1 NEW DFN,MDALP,MDARES
KILL ^UTILITY("VASD",$JOB)
SET DFN=MDPAT
+2 SET X1=DT
SET X2=365
DO C^%DTC
SET VASD("T")=X+.24
SET VASD("F")=DT
SET VASD("W")="129"
SET VASD("C",+MDDA)=+MDDA
DO SDA^VADPT
+3 SET MDARES=0
FOR MDALP=0:0
SET MDALP=$ORDER(^UTILITY("VASD",$JOB,MDALP))
if MDALP<1
QUIT
SET MDARES=$GET(^(MDALP,"I"))
QUIT
+4 KILL ^UTILITY("VASD",$JOB),VASD,X1,X2,X
+5 QUIT MDARES
CHELP ; Help Message for the Schedule Appointment prompt
+1 WRITE !!,"REQUIRED field for the procedure to have auto CP study check-in."
+2 WRITE !,"Enter a ""^"" will exit completely."
+3 WRITE !!,"Enter 0 if you do not schedule appointments."
+4 WRITE !," 1 if you only schedule appointments for outpatients."
+5 WRITE !," 2 if you only schedule appointments for inpatients."
+6 WRITE !," 3 if you schedule appointments for both 1 and 2."
+7 QUIT
PHELP ; Help Message for Procedure prompt
+1 WRITE !,"Enter a CP Definition for the procedure to"
+2 WRITE !,"have auto CP study check-in.",!
+3 KILL MDLST
DO GETLST^XPAR(.MDLST,"SYS","MD CHECK-IN PROCEDURE LIST")
+4 FOR MDLP=0:0
SET MDLP=$ORDER(MDLST(MDLP))
if MDLP<1
QUIT
IF +$GET(MDLST(MDLP))
WRITE !,$PIECE($GET(^MDS(702.01,+MDLST(MDLP),0)),"^",1)
+5 KILL MDLST
+6 QUIT
