| 1 | LR7OB68 ;slc/dcm - Get Lab data from 68 ;8/11/97
|
|---|
| 2 | ;;5.2;LAB SERVICE;**121**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | 68(CTR,ACCDT,ACC,ACCN,TEST) ;Get data from file 68
|
|---|
| 5 | ;CTR=Counter
|
|---|
| 6 | ;ACCDT=Accession Date subscript
|
|---|
| 7 | ;ACC=Accession area subscript
|
|---|
| 8 | ;ACCN=Accession # subscript
|
|---|
| 9 | ;TEST=test ptr
|
|---|
| 10 | ;See ^LR7OB69 for description of LRX array
|
|---|
| 11 | N X0,XP1,XP2,X3,IFN,Y1,Y2,Y3,Y4,Y5,Y6,Y7 K ^TMP("LRX",$J,68)
|
|---|
| 12 | Q:'$D(^LRO(68,+ACC,1,+ACCDT,1,+ACCN,0)) S X0=^(0),XP1=$G(^(.1)),XP2=$G(^(.2)),X3=$G(^(3))
|
|---|
| 13 | S Y1=+XP1,Y2=$P(X0,"^"),Y3=XP2,Y4=$P(X3,"^"),Y5=$P(X3,"^",3),Y6=$P(X3,"^",4),Y7=$P(X3,"^",5)
|
|---|
| 14 | S ^TMP("LRX",$J,69,CTR,68)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^"_Y7
|
|---|
| 15 | I $D(^LRO(68,ACC,1,ACCDT,1,ACCN,4,TEST)) S X=^(TEST,0),^TMP("LRX",$J,69,CTR,68,TEST)=+X_"^"_$P(X,"^",2)_"^"_$P(X,"^",4)_"^"_$P(X,"^",5) D 63^LR7OB63(CTR,Y2,$P($G(^LRO(68,ACC,0)),"^",2),Y7,+$G(CORRECT))
|
|---|
| 16 | Q
|
|---|
| 17 | A68(ACCDT,ACC,ACCN) ;Get data from file 68 when no 69 data exists
|
|---|
| 18 | ;Used for accessions that have no corresponding entries in file 69
|
|---|
| 19 | ;i.e. CY,EM,AU,SP (as of this version they all do)
|
|---|
| 20 | ;ACCDT=Accession Date subscript
|
|---|
| 21 | ;ACC=Accession area subscript
|
|---|
| 22 | ;ACCN=Accession # subscript
|
|---|
| 23 | N X0,Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12,XP1,XP2,XAC,GOTCOM
|
|---|
| 24 | Q:'$D(^LRO(68,+ACC,1,+ACCDT,1,+ACCN,0)) S X0=^(0),XP1=$G(^(.1)),XP2=$G(^(.2)),X3=$G(^(3))
|
|---|
| 25 | Q:'$D(^LR(+X0,0)) ;No matching entry in ^LR
|
|---|
| 26 | S Y11=$S($P($G(^LRO(69,+$P(X0,"^",4),1,+$P(X0,"^",5),0)),"^",11):$P(^(0),"^",11),1:""),Y12=$P(X0,"^",10)
|
|---|
| 27 | S:'$D(DFN) DFN=$P(^LR(+X0,0),"^",3) S:'$D(LRDFN) LRDFN=+X0 S:'$D(LRDPF) LRDPF=$P(^LR(+X0,0),"^",2)_$G(^DIC(+$P(^LR(+X0,0),"^",2),0,"GL"))
|
|---|
| 28 | S Y1=+XP1,Y2=+X3,Y3="",Y4="",Y5=$P(X0,"^",4),Y6=$P(X0,"^",8),Y7=$P(X0,"^",7),Y8=$P(X3,"^",3),Y9=$P(X3,"^",4),Y10="",CTR=1
|
|---|
| 29 | S ^TMP("LRX",$J,69)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^"_Y7_"^"_Y8_"^"_Y9_"^"_Y10_"^"_Y11_"^"_Y12
|
|---|
| 30 | S Y1=+XP1,Y2=$P(X0,"^"),Y3=XP2,Y4=$P(X3,"^"),Y5=$P(X3,"^",3),Y6=$P(X3,"^",4),Y7=$P(X3,"^",5)
|
|---|
| 31 | S XAC=$P($G(^LRO(68,ACC,0)),"^",2),X=$S(XAC="CY":$O(^LAB(60,"B","CYTOPATHOLOGY",0)),XAC="EM":$O(^LAB(60,"B","ELECTRON MICROSCOPY",0)),XAC="AU":$O(^LAB(60,"B","AUTOPSY",0)),XAC="SP":$O(^LAB(60,"B","SURGICAL PATHOLOGY",0)),1:"")
|
|---|
| 32 | I X="" S X=$S(XAC="CY":"CYTOPATHOLOGY",XAC="EM":"ELECTRON MICROSCOPY",XAC="AU":"AUTOPSY",XAC="SP":"SURGICAL PATHOLOGY",1:"")
|
|---|
| 33 | S ^TMP("LRX",$J,69,CTR)=X_"^^"_ACCDT_"^"_ACC_"^"_ACCN
|
|---|
| 34 | S ^TMP("LRX",$J,69,CTR,68)=Y1_"^"_Y2_"^"_Y3_"^"_Y4_"^"_Y5_"^"_Y6_"^"_Y7
|
|---|
| 35 | S TEST=0 F S TEST=$O(^LRO(68,ACC,1,ACCDT,1,ACCN,4,TEST)) Q:TEST<1 S X=^(TEST,0),^TMP("LRX",$J,69,CTR,68,TEST)=+X_"^"_$P(X,"^",2)_"^"_$P(X,"^",4)_"^"_$P(X,"^",5) D 63^LR7OB63(CTR,Y2,XAC,Y7,+$G(CORRECT))
|
|---|
| 36 | Q
|
|---|
