| [613] | 1 | LRUA ;AVAMC/REG/WTY - ANAT PATH UTILITY ;10/23/01
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,173,201,213,259**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to ^DIC supported by IA #916
|
|---|
| 5 | ;Reference to ^DIC(7 supported by IA #2252
|
|---|
| 6 | ;
|
|---|
| 7 | S LRPF=^DIC($P(^LR(LRDFN,0),"^",2),0,"GL"),LRFLN=+$P(@(LRPF_"0)"),"^",2)
|
|---|
| 8 | S DFN=$P(^LR(LRDFN,0),"^",3),LRDPF=$P(^(0),U,2),W=^(LRSS,LRI,0)
|
|---|
| 9 | S LRW(1)=$E($P(W,"^",10),2,3)
|
|---|
| 10 | S LRLLOC=$P(W,"^",8),LRAC=$P(W,"^",6),LRPMD=$P(W,"^",2)
|
|---|
| 11 | S LRRMD=$P(W,"^",4),LRMD=$P(W,"^",7),LRW(5)=$P(W,"^",5)
|
|---|
| 12 | S LRW(9)=$P(W,"^",9),SSN=@(LRPF_DFN_",0)")
|
|---|
| 13 | S Y=+W D DATE S LRTK=Y,Y=$P(W,"^",10) D DATE S LRTK(1)=Y
|
|---|
| 14 | I LRMD S X=LRMD D D S LRMD=X
|
|---|
| 15 | I LRPMD S X=LRPMD D D S LRPMD=X
|
|---|
| 16 | I LRRMD S X=LRRMD D D S LRRMD=X
|
|---|
| 17 | S (LRADM,LRADX,DOB)=""
|
|---|
| 18 | S Y=$P(W,"^",3) D DATE S LRRC=$S(Y["1700":"",1:Y)
|
|---|
| 19 | S LRP=$P(SSN,"^"),SEX=$P(SSN,"^",2),(X2,Y)=$P(SSN,"^",3)
|
|---|
| 20 | S SSN=$P(SSN,"^",9) D SSN^LRU
|
|---|
| 21 | D DEM^LRX,DD^LRX S DOB=Y
|
|---|
| 22 | I LRPF="^DPT(" K VAIN D INPPT^LRX S LRADX=VAIN(9),LRADM=$P(VAIN(7),U,2)
|
|---|
| 23 | Q
|
|---|
| 24 | SET ;
|
|---|
| 25 | S X=$G(^LRO(69.2,LRAA,0)),LR(69.2,.03)=$P(X,U,3),LR(69.2,.04)=$P(X,U,4),LR(69.2,.05)=$P(X,U,5),LR(69.2,.13)=$P(X,U,13),LR(69.2,.14)=$P(X,U,14)
|
|---|
| 26 | ;
|
|---|
| 27 | EN ;
|
|---|
| 28 | S X=+$O(^LRO(68,"B","AUTOPSY",0)),X=$S($D(^LRO(69.2,X,0)):^(0),1:""),LRAU(1)=$P(X,"^",3),LRAU(2)=$P(X,"^",4)
|
|---|
| 29 | D FIELD^DID(63.819,.01,"","POINTER","LR") S LR("SP")=LR("POINTER")
|
|---|
| 30 | D FIELD^DID(63.219,.01,"","POINTER","LR") S LR("EM")=LR("POINTER")
|
|---|
| 31 | D FIELD^DID(63.919,.01,"","POINTER","LR") S LR("CY")=LR("POINTER")
|
|---|
| 32 | D FIELD^DID(63.26,.01,"","POINTER","LR") S LR("AU")=LR("POINTER")
|
|---|
| 33 | D FIELD^DID(63,13.7,"","POINTER","LR") S LRAU("T")=LR("POINTER")
|
|---|
| 34 | D FIELD^DID(63,14.5,"","POINTER","LR") S LRAU("L")=LR("POINTER")
|
|---|
| 35 | D FIELD^DID(63.26,.01,"","POINTER","LR") S LRAU("S")=LR("POINTER")
|
|---|
| 36 | Q
|
|---|
| 37 | C ;
|
|---|
| 38 | S X("L")="" F X(1)=1:1:$L(X) S X("L")=X("L")_$C($A(X,X(1))+($E(X,X(1))?1U*32))
|
|---|
| 39 | S X=X("L") Q
|
|---|
| 40 | ;string X => lower case do C; upper case do U
|
|---|
| 41 | U S X("U")="" F X(1)=1:1:$L(X) S X("U")=X("U")_$C($A(X,X(1))-($E(X,X(1))?1L*32))
|
|---|
| 42 | S X=X("U") Q
|
|---|
| 43 | P S LRMD(1)="" D D S LRMD=X Q
|
|---|
| 44 | ;
|
|---|
| 45 | D ;Name formatting
|
|---|
| 46 | I $D(^VA(200,X,0)) D
|
|---|
| 47 | .Q:'$D(LRSS)
|
|---|
| 48 | .I LRSS'="BB" D
|
|---|
| 49 | ..N LRNAME,FMTNAM
|
|---|
| 50 | ..S LRNAME("FILE")=200,LRNAME("FIELD")=.01,LRNAME("IENS")=X_","
|
|---|
| 51 | ..S LRMD(1)=X,X=+$P($G(^VA(200,X,"PS")),"^",5)
|
|---|
| 52 | ..S FMTNAM=$$NAMEFMT^XLFNAME(.LRNAME,"G","D")
|
|---|
| 53 | ..S X=FMTNAM
|
|---|
| 54 | .I LRSS="BB" D
|
|---|
| 55 | ..S LRMD(1)=X,X(2)=$P(^(0),"^"),X=+$P($G(^("PS")),"^",5)
|
|---|
| 56 | ..S X(1)=$P($G(^DIC(7,X,0)),"^",2)
|
|---|
| 57 | ..S X=$P(X(2),",",2)_" "_$P(X(2),",")_" "_X(1)
|
|---|
| 58 | Q
|
|---|
| 59 | EN1 ;
|
|---|
| 60 | W !?21,"1. Add patient(s) to report print queue",!?21,"2. Delete report print queue",!?21,"3. Print single report only",!?21,"4. Print all reports on print queue"
|
|---|
| 61 | R !,"Select print option: ",LRAPX:DTIME I LRAPX=""!(X[U) K LRAPX Q
|
|---|
| 62 | I LRAPX<1!(LRAPX>4) W $C(7)," SELECT A NUMBER FROM 1-4",! G EN1
|
|---|
| 63 | Q
|
|---|
| 64 | EN2 ; set variable for accession prefix
|
|---|
| 65 | S LRQ(8)=$S($D(^LRO(69.2,LRAA,0)):$P(^(0),"^",8),1:"")
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | DATE ; Returns date in Mon day,year time (if appropriate) format
|
|---|
| 69 | S Y=$TR($$FMTE^XLFDT(Y,"M"),"@"," ")
|
|---|
| 70 | Q
|
|---|
