| [613] | 1 | IMRSUDRA ;HCIOFO/NCA/FAI-Print Radiology Utility Report ;7/17/97 09:39
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
|
|---|
| 3 | DQ ; Process Radiology Report
|
|---|
| 4 | K ^TMP($J) S (IMRPG,IMRUT)=0
|
|---|
| 5 | S (IMRPAT,IMRCPR,IMRDPR,IMRTTP)=""
|
|---|
| 6 | D NOW^%DTC S IMRDTE=%,Y=IMRDTE D DD^%DT S IMRDTE=Y
|
|---|
| 7 | F IMRRL=0:0 S IMRRL=$O(^IMR(158,IMRRL)) Q:IMRRL'>0 S X=+^(IMRRL,0),IMR0C=+$P(^(0),U,42) D XOR^IMRXOR S IMRDFN=X I $D(^DPT(IMRDFN,0)) D CAT^IMRUTL S IMR1C=$S(IMR2C:"C"_IMR0C,1:"CT") D C1
|
|---|
| 8 | D C2,PRNT^IMRRADL1
|
|---|
| 9 | I 'IMRUT D EOP^IMRRADL1
|
|---|
| 10 | Q
|
|---|
| 11 | KIL Q
|
|---|
| 12 | Q
|
|---|
| 13 | C1 ; Get the Radiology Data
|
|---|
| 14 | S (IMRSTAT,IMRPN,IMRPR,IMRRDT,IMRCPT)="",IMRPCTR=1 K IMRCTR
|
|---|
| 15 | S IMR0C=IMR0C+1 S:'IMR2C IMR0C=6
|
|---|
| 16 | D RAD^IMRUTL Q:'$D(^TMP($J,"RAE1",IMRDFN))
|
|---|
| 17 | S IMRI="" F S IMRI=$O(^TMP($J,"RAE1",IMRDFN,IMRI)) Q:IMRI="" S IMRX=$G(^(IMRI)) D
|
|---|
| 18 | .S IMRPR=$E($P(IMRX,"^",1),1,30),IMRCPT=$P(IMRX,"^",10) Q:IMRPR=""
|
|---|
| 19 | .S IMRRDT=9999999.9999-$P(IMRI,"-",1),IMRPN=IMRPR_"~"_IMRCPT
|
|---|
| 20 | .S:'$D(^TMP($J,"IMRPT",IMR1C,IMRDFN)) ^(IMRDFN)=""
|
|---|
| 21 | .S IMRCTR=$G(^TMP($J,"IMRPT",IMR1C,IMRDFN))
|
|---|
| 22 | .I '$D(^TMP($J,"IMRT",IMR1C,IMRDFN,IMRPN)) S ^(IMRPN)=0_"^"_IMRPCTR,$P(IMRCTR,"^",2)=$P(IMRCTR,"^",2)+1
|
|---|
| 23 | .S IMRX1=$G(^TMP($J,"IMRT",IMR1C,IMRDFN,IMRPN))
|
|---|
| 24 | .S $P(^TMP($J,"IMRT",IMR1C,IMRDFN,IMRPN),"^",1)=$P(IMRX1,"^",1)+1,$P(IMRCTR,"^",1)=$P(IMRCTR,"^",1)+1
|
|---|
| 25 | .S $P(IMRCPR,"^",IMR0C)=$P(IMRCPR,"^",IMR0C)+1
|
|---|
| 26 | .S ^TMP($J,"IMRPT",IMR1C,IMRDFN)=IMRCTR Q
|
|---|
| 27 | S IMRPN="" F S IMRPN=$O(^TMP($J,"IMRT",IMR1C,IMRDFN,IMRPN)) Q:IMRPN="" S X=$G(^(IMRPN)) D
|
|---|
| 28 | .I '$D(^TMP($J,"IMRPR",IMR1C,IMRPN)) S ^(IMRPN)=0,$P(IMRDPR,"^",IMR0C)=$P(IMRDPR,"^",IMR0C)+1
|
|---|
| 29 | .S Y=$G(^TMP($J,"IMRPR",IMR1C,IMRPN))
|
|---|
| 30 | .S $P(Y,"^",1)=$P(Y,"^",1)+X,$P(Y,"^",2)=$P(Y,"^",2)+$P(X,"^",2)
|
|---|
| 31 | .S $P(IMRTTP,"^",IMR0C)=$P(IMRTTP,"^",IMR0C)+$P(X,"^",2)
|
|---|
| 32 | .S ^TMP($J,"IMRPR",IMR1C,IMRPN)=Y
|
|---|
| 33 | .Q
|
|---|
| 34 | S $P(IMRPAT,"^",IMR0C)=$P(IMRPAT,"^",IMR0C)+1
|
|---|
| 35 | K ^TMP($J,"IMRT"),^TMP($J,"RAE1")
|
|---|
| 36 | Q
|
|---|
| 37 | C2 ; Set tabulation in ^TMP for each category and All
|
|---|
| 38 | I 'IMR2C S IMR1C="CT" D C3,C31,REMOV Q
|
|---|
| 39 | F IMR0C=0:1:4 S IMR1C="C"_IMR0C D C3,C31
|
|---|
| 40 | REMOV K ^TMP($J,"IMRPR"),^TMP($J,"IMRPT")
|
|---|
| 41 | Q
|
|---|
| 42 | C3 ; Set in ^TMP in order of total Procedures
|
|---|
| 43 | S IMRPRN="" F S IMRPN=$O(^TMP($J,"IMRPR",IMR1C,IMRPN)) Q:IMRPN="" S X=$G(^(IMRPN)),^TMP($J,"IMRPRN",IMR1C,+X,IMRPN)=X
|
|---|
| 44 | Q
|
|---|
| 45 | C31 Q:'IMRRMAX F IMRDFN=0:0 S IMRDFN=$O(^TMP($J,"IMRPT",IMR1C,IMRDFN)) Q:IMRDFN<1 S X=$G(^(IMRDFN)),^TMP($J,"IMRPAT",IMR1C,+X,IMRDFN)=X
|
|---|
| 46 | Q
|
|---|
