| 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
 | 
|---|