source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORDVX1.m@ 1437

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1ORDVX1 ; slc/dcm - OE/RR Extract Lab AP Reports ;3/22/03 9:34
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 199;Build 242
3 ; Modified from Health Summary Extract ^GMTSLREE
4 ; External References
5 ; DBIA 525 ^LR(
6 ; DBIA 10011 ^DIWP
7 ;
8XEM ; Extract EM Data
9 N IX0,IX K ^TMP("OROOT",$J) S IX=OROMEGA
10 F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"EM",IX)) Q:IX'>0!(IX>ORALPHA) D APSET("EM")
11 Q
12XSP ; Extract SP Data
13 N IX0,IX K ^TMP("OROOT",$J) S IX=OROMEGA
14 F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"SP",IX)) Q:IX'>0!(IX>ORALPHA) D APSET("SP")
15 Q
16XCY ; Extract CY Data
17 N IX0,IX K ^TMP("OROOT",$J) S IX=OROMEGA
18 F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"CY",IX)) Q:IX'>0!(IX>ORALPHA) D APSET("CY")
19 Q
20APSET(LRSS) ; Sets ^TMP("OROOT",$J
21 N ACC,CDT,DA,DIC,DIQ,DR,GMW,SN,X,YR
22 S CDT=$P(^LR(LRDFN,LRSS,IX,0),U),ACC=$P(^(0),U,6)
23 ;I $S(+$P(^LR(LRDFN,LRSS,IX,0),U)'>0:1,+$P(^(0),U,11)'>0:1,1:0) Q
24 I $D(ACC) S IX0=IX0+1
25 S X=CDT D DTM4 S CDT=X K X
26 S ^TMP("OROOT",$J,IX,LRSS,0)=CDT_U_ACC
27 I $D(^LR(LRDFN,LRSS,IX,.1)) S ^TMP("OROOT",$J,IX,LRSS,.1)="Site/Specimen"
28 S SN=0 F S SN=$O(^LR(LRDFN,LRSS,IX,.1,SN)) Q:SN'>0 S ^TMP("OROOT",$J,IX,LRSS,.1,SN)=$P(^LR(LRDFN,LRSS,IX,.1,SN,0),U)
29 K ^TMP("ORC",$J)
30 D EN^LR7OSAP4("^TMP(""ORC"",$J)",LRDFN,LRSS,IX)
31 S J=0,CNT=$O(^TMP("OROOT",$J,IX,LRSS,.2,999999),-1)-1
32 F S J=$O(^TMP("ORC",$J,J)) Q:'J S CNT=CNT+1,^TMP("OROOT",$J,IX,LRSS,.2,CNT)=^TMP("ORC",$J,J,0)
33 K ^TMP("ORC",$J)
34 Q
35DTM4 ; Receives X FM date and returns X in MM/DD/YYYY TT:TT
36 S X=$TR($$FMTE^XLFDT(X,"5ZM"),"@"," ")
37 Q
38ALL ; Get all AP data in one swell foop
39 N IX0,IX K ^TMP("OROOT",$J) S IX=OROMEGA
40 F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"SP",IX)) Q:IX'>0!(IX>ORALPHA) D APSET("SP")
41 S IX=OROMEGA F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"CY",IX)) Q:IX'>0!(IX>ORALPHA) D APSET("CY")
42 S IX=OROMEGA F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"EM",IX)) Q:IX'>0!(IX>ORALPHA) D APSET("EM")
43 Q
Note: See TracBrowser for help on using the repository browser.