Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTST1.m

    r613 r623  
    1 RARTST1 ;HISC/CAH,FPT,GJC,DAD AISC/MJK,RMO-Reports Distribution ;7/23/97  12:44
    2         ;;5.0;Radiology/Nuclear Medicine;**56**;Mar 16, 1998;Build 3
    3         ;Supported IA #10040 ^SC(
    4         ;Supported IA #10060 and #2056 GET1^DIQ of file 200
    5         ;Supported IA #10007 DO^DIC1
    6 1       ;;Routing Queue
    7         N RAOMA S RAOMA="",DIC(0)="AEMQZ"
    8         S DIC("A")="Select Routing Queue: ",DIC("B")="WARD REPORTS"
    9         S DIC("S")="I $S('$D(^(""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
    10         S DIC="^RABTCH(74.3," D ^DIC K DIC G:Y<1 Q
    11         S RAB=+Y,RARTST1=$S(Y(0,0)="REQUESTING PHYSICIAN":0,1:1)
    12         D DIV^RARTST2A G:'$D(RADIV)!('$D(RAIMAG))!('$D(RASRT))!('$D(RAPRT)) Q
    13         G DIP K RA4,RAF408
    14         ;
    15 2       ;;Individual Ward Distribution
    16         N RAOMA S RAOMA=""
    17         S Y=$O(^RABTCH(74.3,"B","WARD REPORTS",0)) Q:'Y  S RAB=Y
    18         D DIV^RARTST2A G:'$D(RADIV)!('$D(RAIMAG))!('$D(RASRT))!('$D(RAPRT)) Q
    19         S RADIC(0)="AEMQ",RADIC="^DIC(42,",RADIC("A")="Select Ward: "
    20         S RADIC("S")="I $P(^(0),U,11)=RA4(RADIV)"
    21         D EN1^RASELCT(.RADIC,"WARD/CLIN") K RADIC I RAQUIT G Q
    22         K RA4,RAF408,RAQUIT S RANGE="^^6" G DIP
    23         ;
    24 3       ;;Single Clinic Distribution
    25         N RAOMA S RAOMA=""
    26         S Y=$O(^RABTCH(74.3,"B","CLINIC REPORTS",0)) Q:'Y  S RAB=Y
    27         D DIV^RARTST2A G:'$D(RADIV)!('$D(RAIMAG))!('$D(RASRT))!('$D(RAPRT)) Q
    28         S RADIC(0)="AEMQ",RADIC="^SC(",RADIC("A")="Select Clinic: "
    29         S RADIC("S")="N RA44 S RA44=$G(^(0)) I $P(RA44,U,3)'=""W"",($P(RA44,U,15)=RA4(RADIV))"
    30         D EN1^RASELCT(.RADIC,"WARD/CLIN") K RADIC I RAQUIT G Q
    31         K RA4,RAF408,RAQUIT S RANGE="^^8" G DIP
    32         ;
    33 4       ;;Distribution File Activity
    34         S DIC="^RABTCH(74.3,",DIC(0)="AEMQ",DIC("A")="Select Routing Queue: ",DIC("B")="WARD REPORTS" D ^DIC K DIC G:Y<0 Q41 S RAB=+Y,RABN=$P(Y,"^",2)
    35         S ZTRTN="S4^RARTST1",ZTSAVE("RAB")="",ZTSAVE("RABN")="" D ZIS^RAUTL G Q4:RAPOP
    36 S4      U IO D HD4 F RADTI=0:0 S RADTI=$O(^RABTCH(74.3,RAB,"L",RADTI)) Q:'RADTI  I $D(^(RADTI,0)) S X=^(0),RADTE=$P(X,"^"),RACT=$P(X,"^",2),RADUZ=+$P(X,"^",3),RARTMES=$P(X,"^",4),RARTCNT=+$P(X,"^",5) D P4 Q:"^"[X
    37 Q4      K DIC,RAPOP,RADTI,RAPAGE,RARTCNT,RABN,RAIOM,RAIOSL,RAB,RADTE,RADATE,RADUZ,RACT,RARTMES,X,Y D CLOSE^RAUTL
    38 Q41     K POP,DUOUT,I,RAMES,ZTDESC,ZTRTN,ZTSAVE
    39         Q
    40 P4      N DIERR
    41         S Y=RADTE D D^RAUTL S RADATE=Y,RACT=$S(RACT="P":"PRINT",RACT="R":"RE-PRINT",1:"UNKNOWN"),RADUZ=$$GET1^DIQ(200,RADUZ_",",.01) S:RADUZ="" RADUZ="UNKNOWN"
    42         D HD4:($Y+4)>IOSL Q:"^"[X  W !,RADATE,?20,RACT,?30,$E(RADUZ,1,15),?50,$E(RARTMES,1,20),?72,RARTCNT
    43         Q
    44 HD4     S RAPAGE=$S($D(RAPAGE):RAPAGE+1,1:1)
    45         I RAPAGE>1 R !!,"Press RETURN to continue or '^' to stop",X:DTIME I X["^" S X="^" Q
    46         W @IOF,!,RABN_" Distribution Activity Log",?70,"Page: ",RAPAGE,!,"Run Date: " S X="NOW",%DT="TX" D ^%DT K %DT D D^RAUTL W Y
    47         W !!,"Log Date",?20,"Activity",?30,"User",?50,"Comment",?72,"Qty",!,"--------",?20,"--------",?30,"----",?50,"-------",?72,"---" Q
    48         ;
    49 5       ;;Unprinted Reports List
    50         S DHD="Unprinted Reports List",FLDS="[RA ALL UNPRINTED REPORTS]",BY="[RA ALL UNPRINTED]",RARPTFLG=""
    51         S DIS(0)="S Y=$G(^RABTCH(74.4,D0,0)) I Y S RARPT=+Y,RAB=$P(Y,U,11),RARDIFN=D0,RAY3=$G(^RABTCH(74.4,RARDIFN,0)) I RAY3]"""" S RADFN=+$P($G(^RARPT(RARPT,0)),U,2) D UPDLOC^RAUTL10 I $D(RAPRTOK)" D DIP^RARTST3
    52         K DISH,F,O,RARPTFLG,W,I,POP
    53         Q
    54 6       ;;Clinic Distribution List
    55         S DIC="^SC(",RAWC="Clinic",Y=$O(^RABTCH(74.3,"B","CLINIC REPORTS",0)) Q:'Y  S RAB=+Y G SELECT^RARTST3
    56         ;
    57 7       ;;Ward Distribution List
    58         S RAWC="Ward",DIC="^DIC(42,",Y=$O(^RABTCH(74.3,"B","WARD REPORTS",0)) I 'Y K I,POP Q
    59         S RAB=+Y G SELECT^RARTST3
    60         ;
    61 8       ;;Report's Print Status
    62         S DIC("A")="Select Report: ",DIC="^RARPT(",DIC(0)="AEMQZ"
    63         S DIC("S")="I $P(^(0),U,5)'=""X"""
    64         D DICW,^DIC K DIC I Y<0 D 81 Q
    65         I $P(Y(0),"^",5)'="V" W !!,$C(7),"Report has not been 'verified'." W ! D 81 G 8
    66         I '$D(^RABTCH(74.4,"B",+Y)) W !!,$C(7),"Report is not in any distribution queue." W ! D 81 G 8
    67         S RADFN=+$P(Y(0),U,2),(D0,RARPT)=+Y F RAD0=0:0 S RAD0=$O(^RABTCH(74.4,"B",D0,RAD0)) Q:RAD0'>0  S RAB=$S($D(^RABTCH(74.4,RAD0,0)):$P(^(0),"^",11),1:""),RARDIFN=RAD0,RAY3=$G(^RABTCH(74.4,RARDIFN,0)) I RAY3]"" D UPDLOC^RAUTL10
    68         K DXS D RPTST^RARTST2A(RARPT)
    69 81      K %,C,D,D0,DDH,DILCT,DIPGM,DISTP,DN,DISYS,POP,RASSN,RAY3
    70         K %,DIXX,DXS,I,RAB,RABTY,RACN,RAD0,RADFN,RAPRTOK,RARDIFN,RARPT,X,X1,Y
    71         Q
    72 DIP     ;RANGE defined only if prt'g via 'Individual Ward' or 'Single Clinic'
    73         ;D DIV^RARTST2A G:'$D(RADIV)!('$D(RAIMAG))!('$D(RASRT))!('$D(RAPRT)) Q
    74         I $D(RANGE) S RANGE=$TR(RANGE,"^","~")
    75         ;**** NEXT LINE FOR TESTING ONLY ***
    76         ;D ^%ZIS D START^RARTST2
    77         W ! S ZTRTN="START^RARTST2",ZTSAVE("RADIV")="",ZTSAVE("RAIMAG(")="",ZTSAVE("RASRT")="",ZTSAVE("RAB")="",ZTSAVE("RALOCSRT")="",IOP="Q"
    78         S:$D(RABEG) ZTSAVE("RABEG")="",ZTSAVE("RAEND")=""
    79         S:$D(RA4) ZTSAVE("RA4(")="" S:$D(RAF408) ZTSAVE("RAF408(")=""
    80         I $D(RANGE) S ZTSAVE("RANGE")="",ZTSAVE("^TMP($J,""WARD/CLIN"",")=""
    81         D ZIS^RAUTL K IOP
    82 Q       K %,%DT,D,D0,D1,DA,DDH,DIC,DIE,DIR,DIRUT,DIXX,J,POP,RAB,RABEG,RACN,RADIV,RAEND,RAIMAG,RANGE,RAPOP,RAPRT,RAQUIT,RARD,RARTST1,RALOCSRT,RASRT,X,X1,Y,^TMP($J,"WARD/CLIN")
    83         D CLOSE^RAUTL K DISYS,DUOUT,I,POP,RA4,RAF408,RAMES,ZTDESC,ZTRTN,ZTSAVE
    84         Q
    85 DICW    ; Build DIC("W") string
    86         N DO D DO^DIC1
    87         S DIC("W")=$S($G(DIC("W"))]"":DIC("W")_" ",1:"")_"W ""   "",$$FLD^RARTFLDS(+Y,""PROC"")"
    88         Q
     1RARTST1 ;HISC/CAH,FPT,GJC,DAD AISC/MJK,RMO-Reports Distribution ;7/23/97  12:44
     2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
     31 ;;Routing Queue
     4 N RAOMA S RAOMA="",DIC(0)="AEMQZ"
     5 S DIC("A")="Select Routing Queue: ",DIC("B")="WARD REPORTS"
     6 S DIC("S")="I $S('$D(^(""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)"
     7 S DIC="^RABTCH(74.3," D ^DIC K DIC G:Y<1 Q
     8 S RAB=+Y,RARTST1=$S(Y(0,0)="REQUESTING PHYSICIAN":0,1:1)
     9 D DIV^RARTST2A G:'$D(RADIV)!('$D(RAIMAG))!('$D(RASRT))!('$D(RAPRT)) Q
     10 G DIP K RA4,RAF408
     11 ;
     122 ;;Individual Ward Distribution
     13 N RAOMA S RAOMA=""
     14 S Y=$O(^RABTCH(74.3,"B","WARD REPORTS",0)) Q:'Y  S RAB=Y
     15 D DIV^RARTST2A G:'$D(RADIV)!('$D(RAIMAG))!('$D(RASRT))!('$D(RAPRT)) Q
     16 S RADIC(0)="AEMQ",RADIC="^DIC(42,",RADIC("A")="Select Ward: "
     17 S RADIC("S")="I $P(^(0),U,11)=RA4(RADIV)"
     18 D EN1^RASELCT(.RADIC,"WARD/CLIN") K RADIC I RAQUIT G Q
     19 K RA4,RAF408,RAQUIT S RANGE="^^6" G DIP
     20 ;
     213 ;;Single Clinic Distribution
     22 N RAOMA S RAOMA=""
     23 S Y=$O(^RABTCH(74.3,"B","CLINIC REPORTS",0)) Q:'Y  S RAB=Y
     24 D DIV^RARTST2A G:'$D(RADIV)!('$D(RAIMAG))!('$D(RASRT))!('$D(RAPRT)) Q
     25 S RADIC(0)="AEMQ",RADIC="^SC(",RADIC("A")="Select Clinic: "
     26 S RADIC("S")="N RA44 S RA44=$G(^(0)) I $P(RA44,U,3)'=""W"",($P(RA44,U,15)=RA4(RADIV))"
     27 D EN1^RASELCT(.RADIC,"WARD/CLIN") K RADIC I RAQUIT G Q
     28 K RA4,RAF408,RAQUIT S RANGE="^^8" G DIP
     29 ;
     304 ;;Distribution File Activity
     31 S DIC="^RABTCH(74.3,",DIC(0)="AEMQ",DIC("A")="Select Routing Queue: ",DIC("B")="WARD REPORTS" D ^DIC K DIC G:Y<0 Q41 S RAB=+Y,RABN=$P(Y,"^",2)
     32 S ZTRTN="S4^RARTST1",ZTSAVE("RAB")="",ZTSAVE("RABN")="" D ZIS^RAUTL G Q4:RAPOP
     33S4 U IO D HD4 F RADTI=0:0 S RADTI=$O(^RABTCH(74.3,RAB,"L",RADTI)) Q:'RADTI  I $D(^(RADTI,0)) S X=^(0),RADTE=$P(X,"^"),RACT=$P(X,"^",2),RADUZ=+$P(X,"^",3),RARTMES=$P(X,"^",4),RARTCNT=+$P(X,"^",5) D P4 Q:"^"[X
     34Q4 K DIC,RAPOP,RADTI,RAPAGE,RARTCNT,RABN,RAIOM,RAIOSL,RAB,RADTE,RADATE,RADUZ,RACT,RARTMES,X,Y D CLOSE^RAUTL
     35Q41 K POP,DUOUT,I,RAMES,ZTDESC,ZTRTN,ZTSAVE
     36 Q
     37P4 S Y=RADTE D D^RAUTL S RADATE=Y,RACT=$S(RACT="P":"PRINT",RACT="R":"RE-PRINT",1:"UNKNOWN"),RADUZ=$S($D(^VA(200,RADUZ,0)):$P(^(0),"^"),1:"UNKNOWN")
     38 D HD4:($Y+4)>IOSL Q:"^"[X  W !,RADATE,?20,RACT,?30,$E(RADUZ,1,15),?50,$E(RARTMES,1,20),?72,RARTCNT
     39 Q
     40HD4 S RAPAGE=$S($D(RAPAGE):RAPAGE+1,1:1)
     41 I RAPAGE>1 R !!,"Press RETURN to continue or '^' to stop",X:DTIME I X["^" S X="^" Q
     42 W @IOF,!,RABN_" Distribution Activity Log",?70,"Page: ",RAPAGE,!,"Run Date: " S X="NOW",%DT="TX" D ^%DT K %DT D D^RAUTL W Y
     43 W !!,"Log Date",?20,"Activity",?30,"User",?50,"Comment",?72,"Qty",!,"--------",?20,"--------",?30,"----",?50,"-------",?72,"---" Q
     44 ;
     455 ;;Unprinted Reports List
     46 S DHD="Unprinted Reports List",FLDS="[RA ALL UNPRINTED REPORTS]",BY="[RA ALL UNPRINTED]",RARPTFLG=""
     47 S DIS(0)="S Y=$G(^RABTCH(74.4,D0,0)) I Y S RARPT=+Y,RAB=$P(Y,U,11),RARDIFN=D0,RAY3=$G(^RABTCH(74.4,RARDIFN,0)) I RAY3]"""" S RADFN=+$P($G(^RARPT(RARPT,0)),U,2) D UPDLOC^RAUTL10 I $D(RAPRTOK)" D DIP^RARTST3
     48 K DISH,F,O,RARPTFLG,W,I,POP
     49 Q
     506 ;;Clinic Distribution List
     51 S DIC="^SC(",RAWC="Clinic",Y=$O(^RABTCH(74.3,"B","CLINIC REPORTS",0)) Q:'Y  S RAB=+Y G SELECT^RARTST3
     52 ;
     537 ;;Ward Distribution List
     54 S RAWC="Ward",DIC="^DIC(42,",Y=$O(^RABTCH(74.3,"B","WARD REPORTS",0)) I 'Y K I,POP Q
     55 S RAB=+Y G SELECT^RARTST3
     56 ;
     578 ;;Report's Print Status
     58 S DIC("A")="Select Report: ",DIC="^RARPT(",DIC(0)="AEMQZ" D DICW,^DIC K DIC I Y<0 D 81 Q
     59 I $P(Y(0),"^",5)'="V" W !!,*7,"Report has not been 'verified'." W ! D 81 G 8
     60 I '$D(^RABTCH(74.4,"B",+Y)) W !!,*7,"Report is not in any distribution queue." W ! D 81 G 8
     61 S RADFN=+$P(Y(0),U,2),(D0,RARPT)=+Y F RAD0=0:0 S RAD0=$O(^RABTCH(74.4,"B",D0,RAD0)) Q:RAD0'>0  S RAB=$S($D(^RABTCH(74.4,RAD0,0)):$P(^(0),"^",11),1:""),RARDIFN=RAD0,RAY3=$G(^RABTCH(74.4,RARDIFN,0)) I RAY3]"" D UPDLOC^RAUTL10
     62 K DXS D RPTST^RARTST2A(RARPT)
     6381 K %,C,D,D0,DDH,DILCT,DIPGM,DISTP,DN,DISYS,POP,RASSN,RAY3
     64 K %,DIXX,DXS,I,RAB,RABTY,RACN,RAD0,RADFN,RAPRTOK,RARDIFN,RARPT,X,X1,Y
     65 Q
     66DIP ;RANGE defined only if prt'g via 'Individual Ward' or 'Single Clinic'
     67 ;D DIV^RARTST2A G:'$D(RADIV)!('$D(RAIMAG))!('$D(RASRT))!('$D(RAPRT)) Q
     68 I $D(RANGE) S RANGE=$TR(RANGE,"^","~")
     69 ;**** NEXT LINE FOR TESTING ONLY ***
     70 ;D ^%ZIS D START^RARTST2
     71 W ! S ZTRTN="START^RARTST2",ZTSAVE("RADIV")="",ZTSAVE("RAIMAG(")="",ZTSAVE("RASRT")="",ZTSAVE("RAB")="",ZTSAVE("RALOCSRT")="",IOP="Q"
     72 S:$D(RABEG) ZTSAVE("RABEG")="",ZTSAVE("RAEND")=""
     73 S:$D(RA4) ZTSAVE("RA4(")="" S:$D(RAF408) ZTSAVE("RAF408(")=""
     74 I $D(RANGE) S ZTSAVE("RANGE")="",ZTSAVE("^TMP($J,""WARD/CLIN"",")=""
     75 D ZIS^RAUTL K IOP
     76Q K %,%DT,D,D0,D1,DA,DDH,DIC,DIE,DIR,DIRUT,DIXX,J,POP,RAB,RABEG,RACN,RADIV,RAEND,RAIMAG,RANGE,RAPOP,RAPRT,RAQUIT,RARD,RARTST1,RALOCSRT,RASRT,X,X1,Y,^TMP($J,"WARD/CLIN")
     77 D CLOSE^RAUTL K DISYS,DUOUT,I,POP,RA4,RAF408,RAMES,ZTDESC,ZTRTN,ZTSAVE
     78 Q
     79DICW ; Build DIC("W") string
     80 N DO D DO^DIC1
     81 S DIC("W")=$S($G(DIC("W"))]"":DIC("W")_" ",1:"")_"W ""   "",$$FLD^RARTFLDS(+Y,""PROC"")"
     82 Q
Note: See TracChangeset for help on using the changeset viewer.