| 1 | LRAPDPT ;AVAMC/REG/CYM - POW PTS ;2/10/98 22:15 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,114,201**;Sep 27, 1994
|
|---|
| 3 | D ^LRAP G:'$D(Y) END D XR^LRU S LRC=0 W !!?25,LRO(68)," SEARCH FOR",!?28,"PRISONER OF WAR VETERANS",!!
|
|---|
| 4 | DATE D B^LRU G:Y<0 END S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99
|
|---|
| 5 | DEV S ZTRTN="QUE^LRAPDPT" D BEG^LRUTL G:POP!($D(ZTSK)) END
|
|---|
| 6 | QUE U IO K ^TMP($J) S LRB=9999999.98-LRLDT,LRE=9999999.98-LRSDT D L^LRU,S^LRU,H S LR("F")=1
|
|---|
| 7 | F A=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) D LRDFN
|
|---|
| 8 | D W W:IOST'?1"C".E @IOF K ^TMP($J) D END^LRUTL,END Q
|
|---|
| 9 | LRDFN F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN D CK
|
|---|
| 10 | Q
|
|---|
| 11 | CK Q:$P(^LR(LRDFN,0),"^",2)'=2 S DFN=$P(^(0),"^",3),S(4)=""
|
|---|
| 12 | I 'LRC Q:$P($G(^DPT(DFN,.52)),"^",5)'="Y" S X=$P(^(.52),"^",6) S:X X=$S($D(^DIC(22,X,0)):$P(^(0),"^"),1:"") S S(4)=S(4)_"POW " S:$L(X) S(4)=S(4)_" PERIOD "_X
|
|---|
| 13 | I LRC=1 S X=$P($G(^DPT(DFN,.322)),"^",10) Q:X'="Y"
|
|---|
| 14 | S X=^DPT(DFN,0),LRP=$P(X,"^"),LRDPF=2,SSN=$P(X,"^",9),Y=$P(X,"^",3) D D^LRU,SSN^LRU S ^TMP($J,LRP,SSN)=Y_"^"_S(4)_"^"_LRDFN
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | EN ; Persian gulf registry
|
|---|
| 18 | D ^LRAP G:'$D(Y) END D XR^LRU S LRC=1 W !!?25,LRO(68)," SEARCH FOR",!?28,"PERSIAN GULF VETERANS",!! G DATE
|
|---|
| 19 | H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|---|
| 20 | D F^LRU W !,LRO(68)," (",LRABV,")",?40,$S('LRC:" POW VETERANS",1:" *PERSIAN GULF SERVICE* "),!,"From: ",LRSTR," to ",LRLST
|
|---|
| 21 | W !,"Patient",?40,"DOB",?60,"ID",!,LR("%") Q
|
|---|
| 22 | H1 D H Q:LR("Q") W !,LRN,?40,$P(P,"^"),?60,I,!?5,"Continued from page ",LRQ-1 Q
|
|---|
| 23 | W S LRN=0 F A=0:0 S LRN=$O(^TMP($J,LRN)) Q:LRN=""!(LR("Q")) S I=0 D A
|
|---|
| 24 | Q
|
|---|
| 25 | A F B=0:0 S I=$O(^TMP($J,LRN,I)) Q:I=""!(LR("Q")) S P=^(I),LRDFN=+$P(P,"^",3) D:$Y>(IOSL-6) H Q:LR("Q") W !,LRN,?40,$P(P,"^"),?60,I,!?5,$P(P,"^",2) D @$S(LRSS="AU":"AU",1:"AP") W !,LR("%")
|
|---|
| 26 | Q
|
|---|
| 27 | AP F LRI=LRB:0 S LRI=$O(^LR(LRDFN,LRSS,LRI)) Q:'LRI!(LRI>LRE)!(LR("Q")) S LRX=^(LRI,0) I $P($P(LRX,U,6)," ")=LRABV D:$Y>(IOSL-6) H1 Q:LR("Q") W !,"Specimen date: ",$$FMTE^XLFDT(+LRX),?40,"Accession number: ",$P(LRX,"^",6)
|
|---|
| 28 | Q
|
|---|
| 29 | AU S X=$G(^LR(LRDFN,"AU")) I $P($P(X,U,6)," ")=LRABV W !,"Autopsy date: ",$$FMTE^XLFDT(+X),?30,"Autopsy number: ",$P(X,"^",6)
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | END D V^LRU Q
|
|---|
