| [613] | 1 | LRARCAM5 ;DALISC/CKA - ARCHIVED RCS 14-4 REPORT PART 1
|
|---|
| 2 | ;;5.2;LAB SERVICE;**59**;August 31,1995
|
|---|
| 3 | ;same as LRCAPAM5 except for archived wkld file reference
|
|---|
| 4 | EN ;
|
|---|
| 5 | DEVICE ;
|
|---|
| 6 | S %ZIS="Q" D ^%ZIS G:POP EXIT I $D(IO("Q")) G ZTLOAD
|
|---|
| 7 | D WAIT^DICD
|
|---|
| 8 | QUE ;
|
|---|
| 9 | U IO K ^TMP($J,"RCS14-4"),^TMP($J,"LMIP")
|
|---|
| 10 | S (LRERR,LRMT)="" S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 11 | F S LRMT=$O(LRRPTM(LRMT)) Q:LRMT="" S LRTSTOT=0,LRCAP="" D
|
|---|
| 12 | .D INITSUM^LRARCAM7
|
|---|
| 13 | .S:'$D(^TMP($J,"RCS14-4",$P(LRMT,U,2),0)) ^(0)=0 S LRTOT1=^(0)
|
|---|
| 14 | .F S LRCAP=$O(^LAR(67.99999,+LRDA(1),1,+LRDA,1,+LRMT,1,"B",LRCAP)) Q:LRCAP="" D
|
|---|
| 15 | ..S LRCAPN=$O(^LAR(67.99999,+LRDA(1),1,+LRDA,1,+LRMT,1,"B",LRCAP,0))
|
|---|
| 16 | ..I $D(^LAR(67.99999,+LRDA(1),1,+LRDA,1,+LRMT,1,LRCAPN,0))#2 S LRTREAT=0 D S ^TMP($J,"RCS14-4",$P(LRMT,U,2),0)=LRTOT1
|
|---|
| 17 | ...S LRN=$G(^LAR(67.99999,+LRDA(1),1,+LRDA,1,+LRMT,1,LRCAPN,0)),LRN2=+$G(^(2))
|
|---|
| 18 | ...I '$O(^LAR(67.99999,+LRDA(1),1,+LRDA,1,+LRMT,1,LRCAPN,1,0)) S LRCAPIFN=+$O(^LAM("C",$P(LRN,U)_" ",0)) D:LRCAPIFN BMPSUM^LRARCAM7 Q
|
|---|
| 19 | ..S LRCC=$P(LRN,U) S LRCCN=$E($$WKLDNAME^LRARCU(LRCC),1,40)
|
|---|
| 20 | ..S:LRCCN["*ERR" LRERR=LRERR+1
|
|---|
| 21 | ..Q:((LRDTYP=2)&('LRN2))!((LRDTYP=3)&(LRN2))
|
|---|
| 22 | ..D BMPSUM^LRARCAM7
|
|---|
| 23 | ..S:'$D(^TMP($J,"RCS14-4",$P(LRMT,U,2),1,LRCCN,0))#2 ^(0)=$P(LRN,U,1,8)_U_$P(LRN,U,12) F I=2,3,4 S N=$P(LRN,U,I) I N S $P(LRTOT1,U,I)=($P(LRTOT1,U,I)+N)
|
|---|
| 24 | ..S LRTREAT="" F S LRTREAT=$O(^LAR(67.99999,+LRDA(1),1,+LRDA,1,+LRMT,1,LRCAPN,1,"B",LRTREAT)) Q:LRTREAT="" D
|
|---|
| 25 | ...S LRTREATN=$O(^LAR(67.99999,+LRDA(1),1,+LRDA,1,+LRMT,1,LRCAPN,1,"B",LRTREAT,0)),LRN1=^LAR(67.99999,+LRDA(1),1,+LRDA,1,+LRMT,1,LRCAPN,1,LRTREATN,0) D T1
|
|---|
| 26 | D ^LRARCAM6
|
|---|
| 27 | EXIT ;
|
|---|
| 28 | D ^%ZISC
|
|---|
| 29 | D KILLALL^LRARCU
|
|---|
| 30 | K ^TMP($J,"RCS14-4"),^TMP($J,"LMIP"),LRERR
|
|---|
| 31 | Q
|
|---|
| 32 | T1 ;
|
|---|
| 33 | D LKUP S:'$D(^TMP($J,"RCS14-4",$P(LRMT,U,2),1,LRCCN,LRTRN)) ^(LRTRN)=0 S ^(LRTRN)=(^(LRTRN)+$P(LRN1,U,2))
|
|---|
| 34 | S:'$D(^TMP($J,"RCS14-4",$P(LRMT,U,2),LRTRN)) ^(LRTRN)=0 S ^(LRTRN)=(^(LRTRN)+$P(LRN1,U,2))
|
|---|
| 35 | S LRTSTOT=LRTSTOT+$P(LRN1,U,2)
|
|---|
| 36 | Q
|
|---|
| 37 | LKUP ;
|
|---|
| 38 | S NODE=$G(^DIC(42.4,+LRN1,0)),LRCDR=$S($P(NODE,U,6):$P(NODE,U,6),$P(LRN1,U)="XY ":2100,1:2000)
|
|---|
| 39 | S LRTRN="[ "_LRCDR_" ] "_$S($L($P(NODE,U)):$P(NODE,U),LRCDR=2100:"BLOOD BANK",1:"AMBULATORY CARE")
|
|---|
| 40 | S LRSV=$S($L($P(NODE,U,3)):$P(NODE,U,3),1:LRTRN)
|
|---|
| 41 | I $L(LRSV)<4 S LRSV=$S(LRSV="M":"MEDICINE",LRSV="S":"SURGERY",LRSV="P":"PSYCHIATRY",LRSV="NH":"NHCU",LRSV="NE":"NEUROLOGY",LRSV="I":"INTERMEDIATE MED",LRSV="R":"REHAB MEDICINE",1:LRSV)
|
|---|
| 42 | I $L(LRSV)<4 S LRSB=$S(LRSV="SCI":"SPINAL CORD INJURY",LRSV="D":"DOMICILIARY",LRSV="B":"BLIND REHAB",1:"RESPITE CARE")
|
|---|
| 43 | S LRBS=$S($L($P(NODE,U,5)):$P(NODE,U,5),1:LRTRN)
|
|---|
| 44 | S:'$D(^TMP($J,"RCS14-4",$P(LRMT,U,2),3))#2 ^(3)=0 S ^(3)=(^(3)+$P(LRN1,U,2))
|
|---|
| 45 | S:'$D(^TMP($J,"RCS14-4",$P(LRMT,U,2),3,LRSV)) ^(LRSV)=0 S ^(LRSV)=(^(LRSV)+$P(LRN1,U,2))
|
|---|
| 46 | S:'$D(^TMP($J,"RCS14-4",$P(LRMT,U,2),5))#2 ^(5)=0 S ^(5)=(^(5)+$P(LRN1,U,2))
|
|---|
| 47 | S:'$D(^TMP($J,"RCS14-4",$P(LRMT,U,2),5,LRBS)) ^(LRBS)=0 S ^(LRBS)=(^(LRBS)+$P(LRN1,U,2))
|
|---|
| 48 | Q
|
|---|
| 49 | ZTLOAD ;
|
|---|
| 50 | S ZTIO=ION,ZTRTN="QUE^LRARCAM5",ZTDESC="ARCHIVED LR RCS/CDR REPORT"
|
|---|
| 51 | S ZTSAVE("LR*")="",ZTSAVE("LRDA*")=""
|
|---|
| 52 | D ^%ZTLOAD K ZTSK G EXIT
|
|---|
