| 1 | RASTRPT2 ;HISC/SS-Status Tracking Statistics Report ;4/28/00 10:00
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**20,24**;Mar 16, 1998
|
|---|
| 3 | ;Last Modifications by SS on Aug 3,2000 for patch P24
|
|---|
| 4 | ;Select Division, if exists
|
|---|
| 5 | ;Requires RACCESS "DIV" elements. Prompts user to select division(s).
|
|---|
| 6 | ;Creates ^TMP($J,"RA D-TYPE",Division name,Division IEN)="" which
|
|---|
| 7 | ;contains all divisions selected.
|
|---|
| 8 | SELREQ() ;P20 by SS Select requesting location prompt
|
|---|
| 9 | N RAINP,RAUTIL,RADIC,RA11A,RAQQHLP
|
|---|
| 10 | N RA ;push previous to stack
|
|---|
| 11 | S RAQQHLP=""
|
|---|
| 12 | S RAUTIL="RA REQ-LOC"
|
|---|
| 13 | K ^TMP($J,RAUTIL)
|
|---|
| 14 | ASK2 W !,!,"Select all requesting locations? Y/N: " R RAINP:DTIME I '$T W $C(7)," Timed out...." Q -2
|
|---|
| 15 | Q:RAINP="^" "-1^NON"
|
|---|
| 16 | S RAQQHLP="Enter YES to obtain a report for all requesting locations.^Enter NO to select one or more requesting location(s)."
|
|---|
| 17 | S RAINP=$$YESNO(RAINP,RAQQHLP)
|
|---|
| 18 | I RAINP="0" G ASK2
|
|---|
| 19 | I RAINP="Y" Q "0^ALL"
|
|---|
| 20 | I RAINP="N" D
|
|---|
| 21 | .S RADIC("A")="Select requesting location: "
|
|---|
| 22 | .S RADIC="^SC(",RADIC(0)="QEAMZ",X="A",RADIC("B")=""
|
|---|
| 23 | .D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,X,Y
|
|---|
| 24 | .Q
|
|---|
| 25 | N RA20A,RA20B,RA20C,RA20D S (RA20A,RA20B,RA20C)=0
|
|---|
| 26 | F S RA20A=$O(^TMP($J,RAUTIL,RA20A)) Q:RA20A="" S RA20C=RA20A,RA20B=RA20B+1
|
|---|
| 27 | G:RA20B=0 ASK2
|
|---|
| 28 | I RA20B=1 Q "1^"_RA20C_"^"_$O(^TMP($J,RAUTIL,RA20C,0))
|
|---|
| 29 | Q RA20B_"^MULTI"
|
|---|
| 30 | ;
|
|---|
| 31 | SELPROC(RAIMGTP) ;P20 Select procedure prompt
|
|---|
| 32 | N RAINP,RAUTIL,RADIC,RA11A,RAQQHLP
|
|---|
| 33 | N RA ;push previous to stack
|
|---|
| 34 | ASK W !,!,"Select all procedures? Y/N: " R RAINP:DTIME I '$T W $C(7)," Timed out...." Q -2
|
|---|
| 35 | Q:RAINP="^" -1
|
|---|
| 36 | S RAQQHLP="Enter YES to select all procedures^or NO to select a single procedure."
|
|---|
| 37 | S RAINP=$$YESNO(RAINP,RAQQHLP)
|
|---|
| 38 | I RAINP="0" G ASK
|
|---|
| 39 | I RAINP="Y" Q 0
|
|---|
| 40 | I RAINP="N" S DIC="^RAMIS(71,",DIC(0)="QAEMZI" D ^DIC S RA11A=Y K %W,%Y1,DIC,X,Y
|
|---|
| 41 | Q RA11A
|
|---|
| 42 | ;
|
|---|
| 43 | SETTMP ;P20 by SS update data in ^TMP for RASTAT in new format
|
|---|
| 44 | N X,Y,RARQLOC,RA11,RA11A S RA11=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:RA11=""
|
|---|
| 45 | S RA11A=$P(RA11,"^",22) I RA11A="" S RARQLOC=$P(RA11,"^",9)
|
|---|
| 46 | S RARQLOC=$S(RA11A="":"Unknown",1:$E($P(^SC(RA11A,0),"^",1),1,200))
|
|---|
| 47 | S $P(RACURREC("L"),"^",2)=RARQLOC
|
|---|
| 48 | ;set PROC
|
|---|
| 49 | I '$D(^TMP($J,"RAST",RAIMAGE,RADV,RARQLOC,"PROC",RAFR,RATO,RAPRC)) S ^(RAPRC)=Y1_"^^"_Y1_"^^1^"_Y1
|
|---|
| 50 | E S:+Y1>+$P(^(RAPRC),"^",1) $P(^(RAPRC),"^",1)=Y1 S:+Y1<+$P(^(RAPRC),"^",3) $P(^(RAPRC),"^",3)=Y1 S $P(^(RAPRC),"^",6)=+$P(^(RAPRC),"^",6)+Y1,$P(^(RAPRC),"^",5)=+$P(^(RAPRC),"^",5)+1
|
|---|
| 51 | S X=+$P(^(RAPRC),"^",1) I X'<0 D MINUTS^RAUTL1 S $P(^(RAPRC),"^",2)=Y
|
|---|
| 52 | S X=+$P(^(RAPRC),"^",3) I X'<0 D MINUTS^RAUTL1 S $P(^(RAPRC),"^",4)=Y
|
|---|
| 53 | ;Set SUM
|
|---|
| 54 | I '$D(^TMP($J,"RAST",RAIMAGE,RADV,RARQLOC,"SUM",RAFR,RATO)) S ^(RATO)=Y1_"^^"_Y1_"^^1^"_Y1
|
|---|
| 55 | E S:+Y1>+$P(^(RATO),"^",1) $P(^(RATO),"^",1)=Y1 S:+Y1<+$P(^(RATO),"^",3) $P(^(RATO),"^",3)=Y1 S $P(^(RATO),"^",6)=+$P(^(RATO),"^",6)+Y1,$P(^(RATO),"^",5)=+$P(^(RATO),"^",5)+1
|
|---|
| 56 | S X=+$P(^(RATO),"^",1) I X'<0 D MINUTS^RAUTL1 S $P(^(RATO),"^",2)=Y
|
|---|
| 57 | S X=+$P(^(RATO),"^",3) I X'<0 D MINUTS^RAUTL1 S $P(^(RATO),"^",4)=Y
|
|---|
| 58 | ;Set COMPLETE
|
|---|
| 59 | I '$D(^TMP($J,"RAST",RAIMAGE,RADV,RARQLOC,"COMPLETE")) S ^("COMPLETE")=Y1_"^^"_Y1_"^^1^"_Y1
|
|---|
| 60 | E S:+Y1>+$P(^("COMPLETE"),"^",1) $P(^("COMPLETE"),"^",1)=Y1 S:+Y1<+$P(^("COMPLETE"),"^",3) $P(^("COMPLETE"),"^",3)=Y1 S $P(^("COMPLETE"),"^",6)=+$P(^("COMPLETE"),"^",6)+Y1,$P(^("COMPLETE"),"^",5)=+$P(^("COMPLETE"),"^",5)+1
|
|---|
| 61 | S X=+$P(^("COMPLETE"),"^",1) I X'<0 D MINUTS^RAUTL1 S $P(^("COMPLETE"),"^",2)=Y
|
|---|
| 62 | S X=+$P(^("COMPLETE"),"^",3) I X'<0 D MINUTS^RAUTL1 S $P(^("COMPLETE"),"^",4)=Y
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | YESNO(RAYN,RAQQMRK) ;
|
|---|
| 66 | N RA20,RA20A S RA20=""
|
|---|
| 67 | S RAYN=$$UP^XLFSTR(RAYN)
|
|---|
| 68 | I RAYN="Y"!(RAYN="YE")!(RAYN="YES") Q "Y"
|
|---|
| 69 | I RAYN="N"!(RAYN="NO") Q "N"
|
|---|
| 70 | I RAYN="?" W !,"Answer with either: YES or NO" Q 0
|
|---|
| 71 | I RAYN="??" F RA20A=1:1:5 S RA20=$P(RAQQMRK,"^",RA20A) Q:RA20="" W !,RA20
|
|---|
| 72 | Q "0"
|
|---|
| 73 | ISLOCOK(RA20A,RA20J) ;if it isn't selected location
|
|---|
| 74 | N RA20C,RA20D,RA20FL
|
|---|
| 75 | S (RA20C,RA20FL)=0
|
|---|
| 76 | F S RA20C=$O(^TMP(RA20J,"RA REQ-LOC",RA20C)) Q:RA20C="" D
|
|---|
| 77 | .S RA20D=$O(^TMP(RA20J,"RA REQ-LOC",RA20C,0))
|
|---|
| 78 | .S:RA20D=RA20A RA20FL=1 Q
|
|---|
| 79 | .Q
|
|---|
| 80 | Q RA20FL
|
|---|
| 81 | ;
|
|---|
| 82 | ;Generic Yes/No prompt
|
|---|
| 83 | ;Arguments: text of question,retval for Yes, for No, for ^, treat as "N" or "Y" if empty, help text for ??
|
|---|
| 84 | ASKYN(RAQUEST,RARETYES,RARETNO,RARETUPA,RARETEMP,RAHLP2QM) ;P24
|
|---|
| 85 | ASKAGAN W !,!,RAQUEST R RAINP:DTIME I '$T W $C(7)," Timed out...." Q RARETUPA
|
|---|
| 86 | Q:RAINP="^" RARETUPA
|
|---|
| 87 | S:RAINP="" RAINP=RARETEMP
|
|---|
| 88 | S RAINP=$$YESNO(RAINP,RAHLP2QM)
|
|---|
| 89 | I RAINP="0" G ASKAGAN
|
|---|
| 90 | Q:RAINP="N" RARETNO
|
|---|
| 91 | Q RARETYES
|
|---|
| 92 | ASKDTRPT() ;P24
|
|---|
| 93 | N RAYNQST
|
|---|
| 94 | S RAYNQST="Do you wish to print detailed reports? No// "
|
|---|
| 95 | N RAQQHLP
|
|---|
| 96 | S RAQQHLP="Enter YES to obtain detailed reports 'Procedure Detail by Requesting locations'^and 'Division Summary Requesting Location Details '.^Enter NO to skip the reports."
|
|---|
| 97 | Q $$ASKYN(RAYNQST,1,0,-1,"N",RAQQHLP)
|
|---|
