| [613] | 1 | MDPS3 ; HOIFO/NCA - Remote Data View Data Retriever for CP ;8/26/05 14:37
|
|---|
| 2 | ;;1.0;CLINICAL PROCEDURES;**2,5,13**;Apr 01, 2004;Build 19
|
|---|
| 3 | ; Integration Agreements:
|
|---|
| 4 | ; Reference IA# 2693 [Subscription] TIU Extractions.
|
|---|
| 5 | ; 3067 [Private] Read fields in Consult file (#123) w/FM
|
|---|
| 6 | ; 10104 [Supported] Routine XLFSTR calls.
|
|---|
| 7 | ; 875 [Subscription] Access Order Status file (#100.01)
|
|---|
| 8 | ;
|
|---|
| 9 | GET702(MDGLO,MDDFN,MDC,MDSDT,MDEDT,MDMAX) ; Gather the new 702 entries
|
|---|
| 10 | N MDARR,MDCON,MDDTE,MDLP,MDCODE,MDPROC,MDSTAT,MDX
|
|---|
| 11 | D GP^MDPS5(MDDFN,MDSDT,MDEDT)
|
|---|
| 12 | S MDLP="" F S MDLP=$O(^MDD(702,"B",MDDFN,MDLP)) Q:MDLP<1 D
|
|---|
| 13 | .S MDX=$G(^MDD(702,MDLP,0)) Q:$P(MDX,"^",9)'=3
|
|---|
| 14 | .S MDPROC=$$GET1^DIQ(702,MDLP_",",.04,"E") Q:MDPROC=""
|
|---|
| 15 | .Q:'$P(MDX,U,6)
|
|---|
| 16 | .K ^TMP("MDTIUST",$J) S MDTIUER=""
|
|---|
| 17 | .D EXTRACT^TIULQ($P(MDX,U,6),"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05;70201;70202") Q:+MDTIUER
|
|---|
| 18 | .S MDCODE=$G(^TMP("MDTIUST",$J,$P(MDX,U,6),70201,"E"))
|
|---|
| 19 | .S:MDCODE'="" MDCODE=$$UP^XLFSTR(MDCODE)
|
|---|
| 20 | .I $G(MDC)'="" Q:MDCODE'=$G(MDC)
|
|---|
| 21 | .S MDDTE=$G(^TMP("MDTIUST",$J,$P(MDX,U,6),70202,"I"))
|
|---|
| 22 | .S MDSTAT=$G(^TMP("MDTIUST",$J,$P(MDX,U,6),.05,"E"))
|
|---|
| 23 | .S:'MDDTE MDDTE=$$GET1^DIQ(702,MDLP_",",.02,"I")
|
|---|
| 24 | .K ^TMP("MDTIUST",$J)
|
|---|
| 25 | .S MDCON=$P(MDX,U,5)
|
|---|
| 26 | .I +$G(MDSDT) Q:MDDTE<+$G(MDSDT)
|
|---|
| 27 | .I +$G(MDEDT) Q:MDDTE>+$G(MDEDT)
|
|---|
| 28 | .I MDCON D Q:MDSTAT'="COMPLETE"&(MDSTAT'="PARTIAL RESULTS")
|
|---|
| 29 | ..S MDSTAT=$$GET1^DIQ(123,MDCON_",",8,"E")
|
|---|
| 30 | ..I MDSTAT="" S MDSTAT=$$GET1^DIQ(123,MDCON_",",8,"I") S:+MDSTAT MDSTAT=$$GET1^DIQ(100.01,MDSTAT_",",.01,"E")
|
|---|
| 31 | ..Q
|
|---|
| 32 | .S Y=MDDTE X ^DD("DD") N MDREV S MDREV=(9999999.9999-MDDTE)
|
|---|
| 33 | .I MDCON Q:$G(MDARR(MDCON))'="" S MDARR(MDCON)=MDCON
|
|---|
| 34 | .S:$G(^TMP("MDPLST",$J,MDPROC,MDREV_"^"_MDLP))="" ^(MDREV_"^"_MDLP)=MDPROC_"^"_MDLP_"^"_"PR702"_"^"_"MDPS1"_"^^"_Y_"^"_MDCODE_"^^^^"_MDPROC_"^^"_MDCON_"^"_+$P(MDX,U,6)
|
|---|
| 35 | .Q
|
|---|
| 36 | K MDARR
|
|---|
| 37 | Q
|
|---|
| 38 | PRO(RESULT) ; Function to return info on single procedure.
|
|---|
| 39 | ;
|
|---|
| 40 | ; RESULT = variable pointer to a medicine file
|
|---|
| 41 | ; (e.g. "12;MCAR(691.5,") (required)
|
|---|
| 42 | N MDVAL,LL,S3,S4,S5
|
|---|
| 43 | S S3=+RESULT,S4=$P(RESULT,";",2),S4=$P(S4,",")
|
|---|
| 44 | I S4="MCAR(702.7" Q ""
|
|---|
| 45 | I S4="MCAR(699" S LL=$P($G(^MCAR(699,+S3,0)),U,12),MDVAL=$P($G(^MCAR(697.2,+LL,0)),U) Q MDVAL
|
|---|
| 46 | I S4="MCAR(699.5" S LL=$P($G(^MCAR(699.5,+S3,0)),U,6),MDVAL=$P($G(^MCAR(697.2,+LL,0)),U) Q MDVAL
|
|---|
| 47 | I S4="MCAR(694" S LL=$P($G(^MCAR(699.5,+S3,0)),U,6),MDVAL=$P($G(^MCAR(697.2,+LL,0)),U) Q MDVAL
|
|---|
| 48 | S LL=$O(^MCAR(697.2,"C",S4,0)),MDVAL=$P(^MCAR(697.2,LL,0),U)
|
|---|
| 49 | Q MDVAL
|
|---|
| 50 | CHKMED(MDCON) ; Check for Medicine results
|
|---|
| 51 | N MDCK,MDCX,MDY
|
|---|
| 52 | S MDY=0 D GETS^DIQ(123,MDCON_",","50*","I","MDCX")
|
|---|
| 53 | S MDCK="" F S MDCK=$O(MDCX(123.03,MDCK)) Q:MDCK<1 S MDX4=$G(MDCX(123.03,MDCK,.01,"I")) D
|
|---|
| 54 | .I MDX4["MCAR" S MDY=1
|
|---|
| 55 | Q MDY
|
|---|
| 56 | HDR ; Print Header for Report Form Feed
|
|---|
| 57 | N FFL,MDNM,MDNAME,MDTITL,MDTM S $P(FFL,"-",80)=""
|
|---|
| 58 | S MDNM=$QS(MDREC,4),MDNAME=$O(^MCAR(697.2,"B",MDNM,0))
|
|---|
| 59 | I MDNAME S MDTITL=$P($G(^MCAR(697.2,+MDNAME,0)),"^",8)
|
|---|
| 60 | I $G(MDTITL)="" S MDNAME=$O(^MDS(702.01,"B",MDNM,0)) S:MDNAME MDTITL=$P($G(^MDS(702.01,+MDNAME,0)),U)
|
|---|
| 61 | W !! D NOW^%DTC S X=% D DTIME^MCARP S MDTM=$$FMTE^XLFDT(X,2) K %
|
|---|
| 62 | S MDRPG=MDRPG+1 W !,"Pg. "_MDRPG_$J(" ",25)_$$HOSP^MDPS2(DFN)_$J(" ",25)_MDTM
|
|---|
| 63 | I $G(MDTITL)'="" W !,$J(" ",25)_MDTITL
|
|---|
| 64 | W !,$$DEMO^MDPS2(DFN)
|
|---|
| 65 | W !,FFL
|
|---|
| 66 | Q
|
|---|
