| [613] | 1 | MDPS5 ; HOIFO/NCA - Retrieve List of Consult Procedures for RDV ;3/4/05  13:29 | 
|---|
|  | 2 | ;;1.0;CLINICAL PROCEDURES;**13**;Apr 01, 2004;Build 19 | 
|---|
|  | 3 | ; Integration Agreements: | 
|---|
|  | 4 | ; Reference IA# 2740 [Subscription] Routine GMRCSLM1. | 
|---|
|  | 5 | ; IA# 2944 [Subscription] Calls to TIUSRVR1. | 
|---|
|  | 6 | ; IA# 3067 [Private] Read fields in Consult file (#123) w/FM | 
|---|
|  | 7 | ; | 
|---|
|  | 8 | GP(MDDFN,MDSDT,MDEDT) ; Gather the completed procedure list | 
|---|
|  | 9 | N MDCPR,MDCK,MDCPRO,MDCX,MDDTE,MDLP,MDFIL,MDSTK,MDX4 S MDFIL=123,MDSTK="2,9" | 
|---|
|  | 10 | D OER^GMRCSLM1(MDDFN,"",MDSDT,MDEDT,MDSTK,1) | 
|---|
|  | 11 | I $G(^TMP("GMRCR",$J,"CS",1,0))["< PATIENT DOES NOT HAVE ANY CONSULTS/REQUESTS" Q | 
|---|
|  | 12 | S MDLP="" F  S MDLP=$O(^TMP("GMRCR",$J,"CS",MDLP)) Q:MDLP="AD"  S MDX=$G(^(MDLP,0)) D | 
|---|
|  | 13 | .S MDCPRO=$P(MDX,U,5),MDX=+MDX | 
|---|
|  | 14 | .Q:$$GET1^DIQ(MDFIL,+MDX_",",13,"I")'="P" | 
|---|
|  | 15 | .S MDCPR=$$GET1^DIQ(MDFIL,+MDX_",",4,"I") | 
|---|
|  | 16 | .Q:MDCPR'["GMR(123.3" | 
|---|
|  | 17 | .S MDCPR=+MDCPR S MDFIL=123.3 Q:'$$GET1^DIQ(MDFIL,+MDCPR_",",.05,"I") | 
|---|
|  | 18 | .Q:$O(^MDD(702,"ACON",+MDX,0)) | 
|---|
|  | 19 | .S MDFIL=123 K MDCX D GETS^DIQ(MDFIL,+MDX_",","50*","I","MDCX") | 
|---|
|  | 20 | .S MDCK="" F  S MDCK=$O(MDCX(123.03,MDCK)) Q:MDCK<1  S MDX4=$G(MDCX(123.03,MDCK,.01,"I")) D | 
|---|
|  | 21 | ..I MDX4["TIU" D | 
|---|
|  | 22 | ...S MDFIL=8925,MDDTE=$$GET1^DIQ(MDFIL,+MDX4_",",1201,"I") | 
|---|
|  | 23 | ...S Y=MDDTE X ^DD("DD") N MDREV S MDREV=(9999999.9999-MDDTE) | 
|---|
|  | 24 | ...S:$G(^TMP("MDPLST",$J,MDCPRO,MDREV_"^"_+MDX4))="" ^(MDREV_"^"_+MDX4)=MDCPRO_"^"_+MDX4_"^"_"PRPRO"_"^"_"MDPS4"_"^^"_Y_"^^^^^"_MDCPRO_"^^"_+MDX_"^"_+MDX4,MDFIL=123 | 
|---|
|  | 25 | ...Q | 
|---|
|  | 26 | ..Q | 
|---|
|  | 27 | .Q | 
|---|
|  | 28 | K ^TMP("GMRCR",$J,"CS") | 
|---|
|  | 29 | Q | 
|---|
|  | 30 | PRPRO ; Return the Result Text for File Consult Procedure records | 
|---|
|  | 31 | Q:'$G(MCARGDA) | 
|---|
|  | 32 | N FFF,MDCLIN,MDCON,MDF,MDIMG,MDMCG,MDMED,MDREC,MDPRILV,MDPTR,MDSTUDY,MDTIU,MDX4,PATID,MDRPG,RESULTS | 
|---|
|  | 33 | I '$G(MDALL) K ^TMP("MDPTXT",$J) | 
|---|
|  | 34 | S MDIMG=0,$P(FFF,"-",80)="",MDRPG=0,MDF=123 | 
|---|
|  | 35 | S MDSTUDY=+$G(MCARGDA) | 
|---|
|  | 36 | S (MDPRILV,RESULTS)="",MDCLIN=0 | 
|---|
|  | 37 | I +MDPRILV D TGET^TIUSRVR1(.RESULTS,+MDSTUDY) M ^TMP("MDPTXT",$J,MCARGDA,MCPRO)=@RESULTS K ^TMP("TIUVIEW",$J) Q:+$G(MDALL) | 
|---|
|  | 38 | S:+MDPRILV<1 ^TMP("MDPTXT",$J,MCARGDA,MCPRO,1)=$P(MDPRILV,U,2) | 
|---|
|  | 39 | NXT Q:+$G(MDALL)  Q:+$G(MDRDV) | 
|---|
|  | 40 | I $D(ORHFS) U IO G PRINT^MDPS1 | 
|---|
|  | 41 | G PRINT^MDPS1 | 
|---|