| [613] | 1 | MCARPS1 ;WISC/TJK,RCH-SUMMARY OF PATIENT PROCEDURES (2) ;6/18/97 10:33
|
|---|
| 2 | ;;1.0;CLINICAL PROCEDURES;**5**;Apr 01, 2004;Build 1
|
|---|
| 3 | K ^TMP("MCAR",$J) S S4="" F M=1:1 S S4=$O(^MCAR(690,"AC",DFN,S4)) Q:S4="" D LOCFIL
|
|---|
| 4 | Q
|
|---|
| 5 | LOCFIL G LOCFIL1:$D(S5) S S5="" F K=1:1 S S5=$O(^MCAR(690,"AC",DFN,S4,S5)) Q:S5="" D LOCFIL1
|
|---|
| 6 | K S5 Q
|
|---|
| 7 | LOCFIL1 S S6="" F L=1:1 S S6=$O(^MCAR(690,"AC",DFN,S4,S5,S6)) Q:S6="" D CONT
|
|---|
| 8 | Q
|
|---|
| 9 | CONT ;CONT+1 modified on 2-7-94,S MCFILE..2) added to conform w/alpha site
|
|---|
| 10 | Q:$O(^MDD(702,"ACONV",S6_";"_S5_",",0))
|
|---|
| 11 | I $D(^MCAR(+$P(S5,"(",2),S6,2005)) S MCFILE=+$P(S5,"(",2) D SUM^MCMAG
|
|---|
| 12 | I S5="MCAR(702.7" Q
|
|---|
| 13 | I S5="MCAR(699" S (LL,LL1)=$P($G(^MCAR(699,S6,0)),U,12) Q:LL'>0 S LL=$P($G(^MCAR(697.2,LL,0)),U) G CONT1:'$D(PE) Q:PE'=LL G CONT1
|
|---|
| 14 | ;I S5="MCAR(699.5" S (LL,LL1)=$P($G(^MCAR(699.5,S6,0)),U,6) Q:'LL S LL=$P($G(^MCAR(697.2,LL,0)),U) G CONT1:'$D(PE) Q:PE'=LL G CONT1 ;MC*2.3*8
|
|---|
| 15 | I S5="MCAR(699.5",'$D(PE) D Q ;MC*2.3*8
|
|---|
| 16 | .S LL6=$P($G(^MCAR(699.5,S6,0)),U,6),LL8=$P($G(^MCAR(699.5,S6,0)),U,8)
|
|---|
| 17 | .S (LL,LL1)=$P($G(^MCAR(699.5,S6,0)),U,6) Q:'LL S LL=$P($G(^MCAR(697.2,LL,0)),U) D CONT1
|
|---|
| 18 | I S5="MCAR(699.5",$D(PE) D Q ;MC*2.3*8
|
|---|
| 19 | .S LL6=$P($G(^MCAR(699.5,S6,0)),U,6),LL8=$P($G(^MCAR(699.5,S6,0)),U,8)
|
|---|
| 20 | .S (LL,LL1)=$P($G(^MCAR(699.5,S6,0)),U,6) Q:'LL S LL=$P($G(^MCAR(697.2,LL,0)),U)
|
|---|
| 21 | .N LLX,LLY
|
|---|
| 22 | .S LLX=$O(^MCAR(697.2,"B",PE,0)) Q:'LLX S LLY=$P($G(^MCAR(697.2,LLX,1)),U)
|
|---|
| 23 | .I LLY="S",LLX=LL6 D CONT1
|
|---|
| 24 | .I LLY="P",LLX=LL8 D CONT1
|
|---|
| 25 | I S5[694 S (LL,LL1)=$P($G(^MCAR(694,S6,0)),U,3) Q:'LL S LL=$P(^MCAR(697.2,LL,0),U) G CONT1:'$D(PE) Q:PE'=LL G CONT1
|
|---|
| 26 | ;MFD 2/5/93 I S5[700,$P($G(^MCAR(700,S6,2)),U)'="Y" Q ; exclude unreleased PFT
|
|---|
| 27 | S (LL,LL1)=$O(^MCAR(697.2,"C",S5,0)),LL=$P(^MCAR(697.2,LL,0),U,1)
|
|---|
| 28 | CONT1 ;
|
|---|
| 29 | S REC=$O(^MCAR(697.2,"B",LL,0)) S:REC="" REC=0
|
|---|
| 30 | S MCARCODE=""
|
|---|
| 31 | S MCESON=$P($G(^MCAR(697.2,REC,0)),U,14),MCESKEY=$P($G(^MCAR(697.2,REC,0)),U,15),MCSUP=+$P($G(^MCAR(697.2,REC,0)),U,16)
|
|---|
| 32 | S (MCARSUM,MCARPSUM)="",MCARFILE=U_S5_","_S6_",.2)" S:$D(@MCARFILE) MCARSUM=$P(@MCARFILE,U,1),MCARPSUM=$P(@MCARFILE,U,2)
|
|---|
| 33 | K MCARFILE S S1=$S(WH="P":LL,1:S4),S2=$S(WH="P":S4,1:LL)
|
|---|
| 34 | S MCFILE=+$P(S5,"(",2)
|
|---|
| 35 | I MCESON,($G(MCESKEY)'=""),('$$SCRSUMPT^MCESSCR(MCESKEY,S6,MCSUP)) K MCARSUM,MCARPSUM,MCFILE,REC,MCSUP Q
|
|---|
| 36 | I $P($G(@(U_S5_","_S6_",""ES"")")),U,7)="S" G EXIT ;MC*2.3*8
|
|---|
| 37 | S S2=S2_U_S6 ;MC*2.3*8
|
|---|
| 38 | S ^TMP("MCAR",$J,S1,S2)=MCARSUM_U_S6_U_$P(^MCAR(697.2,LL1,0),U,5,7)
|
|---|
| 39 | S $P(^TMP("MCAR",$J,S1,S2),U,10)=MCARPSUM
|
|---|
| 40 | S $P(^TMP("MCAR",$J,S1,S2),U,11)=LL
|
|---|
| 41 | I S5="MCAR(699.5" D ;MC*2.3*8
|
|---|
| 42 | .I LL8="" S LL8=" "
|
|---|
| 43 | .S $P(^TMP("MCAR",$J,S1,S2),U,12)=$E(($E($P($G(^MCAR(697.2,LL6,0)),U,8),1,13)_"/"_$P($G(^MCAR(697.2,LL8,0)),U)),1,31) K LL6,LL8
|
|---|
| 44 | EXIT K MCARSUM,MCARPSUM,REC,MCSUP,MCESON Q
|
|---|
