| 1 | RAFLM ;HISC/GJC AISC/MJK,RMO-Film Usage Report ;4/17/96 10:15
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**10**;Mar 16, 1998
|
|---|
| 3 | ;
|
|---|
| 4 | I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0) S RAPSTX=""
|
|---|
| 5 | ;
|
|---|
| 6 | SUM W !!,"Film Usage Report",!,"-----------------" K RAFL1
|
|---|
| 7 | ASKSUM W ! K DIR S DIR(0)="Y",DIR("A")="Do you wish only the summary report",DIR("B")="NO",DIR("?")="Enter YES for a summary report or NO for a detailed report"
|
|---|
| 8 | D ^DIR K DIR I $D(DIRUT) D Q^RAFLM2 Q
|
|---|
| 9 | S:Y=0 RAFL1=""
|
|---|
| 10 | K DIROUT,DIRUT,DTOUT,DUOUT
|
|---|
| 11 | S X=$$DIVLOC^RAUTL7() I X D Q^RAFLM2 Q
|
|---|
| 12 | S A="",RATITLE="Film"
|
|---|
| 13 | F S A=$O(RACCESS(DUZ,"DIV-IMG",A)) Q:A']"" D
|
|---|
| 14 | . Q:'$D(^TMP($J,"RA D-TYPE",A)) S A1=$O(^TMP($J,"RA D-TYPE",A,0))
|
|---|
| 15 | . Q:A1'>0 S B=""
|
|---|
| 16 | . F S B=$O(RACCESS(DUZ,"DIV-IMG",A,B)) Q:B']"" D
|
|---|
| 17 | .. I $D(^TMP($J,"RA I-TYPE",B)) D IT^RALWKL2 I B1?3AP1"-".N S ^TMP($J,"RAFLM",A1,B1)=0
|
|---|
| 18 | .. Q
|
|---|
| 19 | . Q
|
|---|
| 20 | K A,A1,B,B1,RACCESS(DUZ,"DIV-IMG")
|
|---|
| 21 | S RAINPUT=$$ALLNOTH^RALWKL3() I RAINPUT="" D Q^RAFLM2 Q
|
|---|
| 22 | I RAINPUT=0 D FILM I RAQUIT=1 D Q^RAFLM2 Q
|
|---|
| 23 | I RAINPUT=0 S RAFLDCNT=0,RALP="" F S RALP=$O(^TMP($J,"RAFILM",RALP)) Q:RALP="" S RAFLDCNT=RAFLDCNT+1
|
|---|
| 24 | K RALP
|
|---|
| 25 | D DATE^RAUTL I RAPOP D Q^RAFLM2 Q
|
|---|
| 26 | S RAXIT=0 D DISPXAM^RALWKL1(6) I RAXIT D Q^RAFLM2 Q
|
|---|
| 27 | S ZTDESC="Rad/Nuc Med FILM USAGE RPT",ZTRTN="START^RAFLM",ZTSAVE("^TMP($J,""RAFILM"",")="",ZTSAVE("^TMP($J,""RAFLM"",")="" S:$D(RAFL1) ZTSAVE("RAFL1")=""
|
|---|
| 28 | F RASV="BEGDATE","ENDDATE","RAFLDCNT","RAINPUT" S ZTSAVE(RASV)=""
|
|---|
| 29 | DEV W ! D ZIS^RAUTL I RAPOP D Q^RAFLM2 Q
|
|---|
| 30 | START ; start processing
|
|---|
| 31 | U IO K ^TMP($J,"RA") S RABEG=BEGDATE-.0001,RAEND=ENDDATE+.9999,RACRT=6 D CRIT^RAUTL1 S RACPT=""
|
|---|
| 32 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 33 | S RAITCNT=0,RALP="",RAEOS=0
|
|---|
| 34 | F S RALP=$O(^TMP($J,"RAFLM",RALP)) Q:RALP="" S RAITCNT(RALP)=0,^TMP($J,"RA",RALP)="0^0" S RALP1="" F S RALP1=$O(^TMP($J,"RAFLM",RALP,RALP1)) Q:RALP1="" S RAITCNT(RALP)=RAITCNT(RALP)+1,^TMP($J,"RA",RALP,RALP1)="0^0"
|
|---|
| 35 | K RALP,RALP1
|
|---|
| 36 | F RADTE=RABEG:0:RAEND S RADTE=$O(^RADPT("AR",RADTE)) Q:RADTE'>0!(RADTE>RAEND)!(RAEOS) F RADFN=0:0 S RADFN=$O(^RADPT("AR",RADTE,RADFN)) Q:RADFN'>0 D RADTI^RAFLM1 Q:RAEOS
|
|---|
| 37 | G:'RAEOS ^RAFLM2
|
|---|
| 38 | Q
|
|---|
| 39 | FILM ; select films to include in report
|
|---|
| 40 | K ^TMP($J,"RAFILM")
|
|---|
| 41 | S RAONECHK=$P(^RA(78.4,0),U,4) I RAONECHK=1 S RAIEN=$O(^RA(78.4,0)) Q:RAIEN<1 S RAONENME=$P(^RA(78.4,+RAIEN,0),U,1),RAONENME=$E(RAONENME,1,30),^TMP($J,"RAFILM",RAONENME)="" D KILL Q
|
|---|
| 42 | S RADIC="^RA(78.4,",RADIC(0)="QEAMZ",RADIC("A")="Select "_RATITLE_": ",RAUTIL="RAFILM"
|
|---|
| 43 | S RADIC("S")="I '$P(^(0),U,4)"
|
|---|
| 44 | D EN1^RASELCT(.RADIC,RAUTIL,"",RAINPUT)
|
|---|
| 45 | KILL ;
|
|---|
| 46 | K %W,%Y1,DIC,RACNT,RADIC,RAIEN,RAONECHK,RAONENME,RAUTIL,X,Y
|
|---|
| 47 | Q
|
|---|
| 48 | CPT ;
|
|---|
| 49 | Q:'$P(RAPRI,"^",9) S RACPT=+$P(RAPRI,"^",9)
|
|---|
| 50 | S RACPT=$$NAMCODE^RACPTMSC(RACPT,DT),RACPT=$P(RACPT,"^")
|
|---|
| 51 | Q:RACPT=""
|
|---|
| 52 | S RAPRC=RAPRC_"("_RACPT_")"
|
|---|
| 53 | Q
|
|---|
