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/RART.m

    r613 r623  
    1 RART    ;HISC/CAH,FPT,GJC AISC/MJK,TMP,RMO-Reporting Menu ;11/16/98  15:02
    2         ;;5.0;Radiology/Nuclear Medicine;**2,5,15,18,43,82,56**;Mar 16, 1998;Build 3
    3         ;Private IA #4793 CREATE^WVRALINK
    4         ;Supoprted IA #3544 ^VA(200,"ARC"
    5         ;;last modification by SS for P18 June 15, 2000
    6 3       ;;Verify a Report
    7         N I5
    8         D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
    9         I $D(RANOSCRN) S X=$$DIVLOC^RAUTL7() I X D Q QUIT
    10         G:$D(^VA(200,"ARC","S",DUZ))!($D(^XUSEC("RA VERIFY",DUZ))) 30
    11         G:$P(RAMDV,"^",18)=1 30
    12         G:'$D(^VA(200,"ARC","R",DUZ)) 30
    13         I $P(RAMDV,"^",18)'=1 W !!,$C(7),"Interpreting Residents are not allowed to verify reports." G Q
    14 30      K RAUP S RAPGM=30,RAREPORT=1 D ^RACNLU G Q:X="^" I '$D(^RARPT(+RARPT,0)) W !!?2,$C(7),"No report available!" G 30
    15         S I5=$P(^RARPT(+RARPT,0),"^",5) I "^V^EF^"[("^"_I5_"^") W !!?2,$C(7),"Report already ",$S(I5="V":"verified",1:"electronically filed") G 30
    16 SS1     Q:$$VERONLY^RAUTL11=-1  ;P18 case info
    17 31      S DIE("NO^")="",DA=RARPT,DR="[RA VERIFY REPORT ONLY]",DIE="^RARPT("
    18         S RAIMGTYI=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2),RAIMGTYJ=$P($G(^RA(79.2,+RAIMGTYI,0)),U)
    19         I RAIMGTYJ']"" W !,"Error: Cannot determine imaging type of exam.",! K RAIMGTYI,RAIMGTYJ G @RAPGM
    20         ; must lock both report AND case together, so to ensure
    21         ; that a verified report has the correct diagnostic codes
    22         S RAXIT=$$LOCK^RAUTL12(DIE,DA) ; lock Report
    23         I RAXIT K RAXIT G @RAPGM
    24         S RASAVDIE="^RADPT("_RADFN_",""DT"","_RADTI_",""P"",",RASAVDA(2)=RADFN,RASAVDA(1)=RADTI,RASAVDA=RACNI
    25         ; rpt exists & locked, thus no need to lock at "DT" level because users
    26         ; can only use 'report entry/edit' option to enter dx's for printsets
    27         S RAXIT=$$LOCK^RAUTL12(RASAVDIE,.RASAVDA) ; lock case before asking REPORT STATUS
    28         I RAXIT K RAXIT G @RAPGM
    29         D ^DIE K DE,DQ,DR D UNLOCK^RAUTL12(DIE,DA) ; unlock Report
    30         K DIE,RAXIT
    31         S X=+$O(^RA(72,"AA",RAIMGTYJ,9,0)),DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
    32         S DR=13_$S(RACT'="V":"",'$D(^RA(72,X,.1)):"",$P(^(.1),"^",5)'="Y":"",1:"R")_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1 "
    33         I RACT="V",($P($G(^RA(72,+X,.1)),"^",5)="Y") S DIE("NO^")="BACK"
    34         D ^DIE
    35         K DA,DE,DQ,DIE,DR
    36         I $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)="" G UNL31
    37         S DR="50///"_RACN
    38         S DR(2,70.03)=13.1
    39         S DR(3,70.14)=.01_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1"
    40         S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT"","
    41         D ^DIE
    42 UNL31   ; copy then unlock
    43         N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR
    44         D EN2^RAUTL20(.RAMEMARR)
    45         I RAPRTSET S RADRS=1,RAXIT=0 D COPY^RARTE2 ; copy diagnoses
    46         D UNLOCK^RAUTL12(RASAVDIE,.RASAVDA) ; use params from PrimDiag's lock
    47         K RASAVDIE,RASAVDA
    48         K DA,DE,DQ,DIE,DR
    49 32      K RAXIT
    50         I $G(RAPGM)="GETRPT^RARTVER" I $E(RACT'="V"),($P(^RARPT(RARPT,0),U,14)]"") D RETURN^RARTVER2
    51 PACS    I (RACT="V")!(RACT="R") D TASK^RAHLO4
    52         I "^V^EF^"[("^"_RACT_"^"),$T(CREATE^WVRALINK)]"" D CREATE^WVRALINK(RADFN,RADTI,RACNI) ;women's health
    53         ;
    54         I RAPGM="NXT^RABTCH1" G @RAPGM
    55 TIME    D:RACT="V"
    56         .N RAHLTCPB S RAHLTCPB=1 D UPSTAT^RAUTL0 K RAAB
    57         I $G(RARDX)="S" D
    58         . D SAVE^RARTVER2
    59         . I $G(RAPGM)="GETRPT^RARTVER" D
    60         .. ; for 'On-line Verifying of Reports' default device selection is the
    61         .. ; "REPORT PRINTER NAME"
    62         .. S %ZIS("B")=$P($G(RAMLC),"^",10) K:%ZIS("B")']"" %ZIS("B")
    63         .. Q
    64         . D Q^RARTR,RESTORE^RARTVER2
    65         . K:$D(%ZIS("B")) %ZIS("B")
    66         . Q
    67         G @RAPGM
    68 Q       K %,%DT,%X,C,D,D0,D1,DA,DIC,RACN,RACNI,RACT,RADATE,RADFN,RADTE,RADTI,RADUZ,RAHEAD,RAI,RAIMGTYI,RAIMGTYJ,RANME,RANUM,RAOR,RAPGM,RAPRC,RAQUIT,RAREPORT,RARPT,RASET,RASN,RASSN,RAST,RASTI,RAUP,RAVER,X,Y,^TMP($J,"RAEX")
    69         K %W,%Y,%Y1,DDER,DI,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,RACI,ZTSK,POP,DDH
    70         Q
    71 OERR1   ; Jump to 'OERR1^RART1' This is necessary to support the reference to
    72         ; this line label in the OE/RR Notifications file.
    73         G OERR1^RART1 Q
    74         ;
    75 PRTDX   ; print dx codes on report display (called from RART1)
    76         K RAFLG D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF))
    77         Q:X="^"!(X="T")!(X="P")
    78         S RADXCODE=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)
    79         W !?3,"Primary Diagnostic Code: ",!?2,$S($D(^RA(78.3,+RADXCODE,0)):$P(^(0),U,1),1:"") K RAFLG
    80         D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="^"!(X="T")!(X="P")
    81         I '$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)) W ! Q
    82         W !!?3,"Secondary Diagnostic Codes: "
    83         S RADXCODE=0
    84         F  S RADXCODE=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE)) Q:RADXCODE'>0!('$D(^RA(78.3,+RADXCODE,0)))!($D(RAOOUT))  K RAFLG D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="^"!(X="T")!(X="P")  W !?2,$P(^RA(78.3,RADXCODE,0),U,1)
    85         W !
    86         Q
    87 EXIT    ; Kill variables created when user prints 'Abnormal Rad/Nuc Med Report
    88         ; Alert'.  Variables are created when 'PRT^RARTR' is called.
    89         K %X,%XX,%Y,%YY,A,DDER,DFN,DI,DIR,DIW,DIWI,DIWT,DIWTC,DIWX,DLAYGO
    90         K DN,RACI,RACN0,RACPT,RACPTNDE,RADTE0,RADTV,RAN,RAOBR4,RAPRCNDE
    91         K RAPROC,RAPROCIT,RAPRV,RARPT0,VA,VADM,VAERR,X2,ZTSK
    92         Q
     1RART ;HISC/CAH,FPT,GJC AISC/MJK,TMP,RMO-Reporting Menu ;11/16/98  15:02
     2 ;;5.0;Radiology/Nuclear Medicine;**2,5,15,18,43,82**;Mar 16, 1998;Build 8
     3 ;;last modification by SS for P18 June 15, 2000
     43 ;;Verify a Report
     5 D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
     6 I $D(RANOSCRN) S X=$$DIVLOC^RAUTL7() I X D Q QUIT
     7 G:$D(^VA(200,"ARC","S",DUZ))!($D(^XUSEC("RA VERIFY",DUZ))) 30
     8 G:$P(RAMDV,"^",18)=1 30
     9 G:'$D(^VA(200,"ARC","R",DUZ)) 30
     10 I $P(RAMDV,"^",18)'=1 W !!,$C(7),"Interpreting Residents are not allowed to verify reports." G Q
     1130 K RAUP S RAPGM=30,RAREPORT=1 D ^RACNLU G Q:X="^" I '$D(^RARPT(+RARPT,0)) W !!?2,$C(7),"No report available!" G 30
     12 I $P(^RARPT(+RARPT,0),"^",5)="V" W !!?2,$C(7),"Report already verified!" G 30
     13SS1 Q:$$VERONLY^RAUTL11=-1  ;P18 case info
     1431 S DIE("NO^")="",DA=RARPT,DR="[RA VERIFY REPORT ONLY]",DIE="^RARPT("
     15 S RAIMGTYI=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2),RAIMGTYJ=$P($G(^RA(79.2,+RAIMGTYI,0)),U)
     16 I RAIMGTYJ']"" W !,"Error: Cannot determine imaging type of exam.",! K RAIMGTYI,RAIMGTYJ G @RAPGM
     17 ; must lock both report AND case together, so to ensure
     18 ; that a verified report has the correct diagnostic codes
     19 S RAXIT=$$LOCK^RAUTL12(DIE,DA) ; lock Report
     20 I RAXIT K RAXIT G @RAPGM
     21 S RASAVDIE="^RADPT("_RADFN_",""DT"","_RADTI_",""P"",",RASAVDA(2)=RADFN,RASAVDA(1)=RADTI,RASAVDA=RACNI
     22 ; rpt exists & locked, thus no need to lock at "DT" level because users
     23 ; can only use 'report entry/edit' option to enter dx's for printsets
     24 S RAXIT=$$LOCK^RAUTL12(RASAVDIE,.RASAVDA) ; lock case before asking REPORT STATUS
     25 I RAXIT K RAXIT G @RAPGM
     26 D ^DIE K DE,DQ,DR D UNLOCK^RAUTL12(DIE,DA) ; unlock Report
     27 K DIE,RAXIT
     28 S X=+$O(^RA(72,"AA",RAIMGTYJ,9,0)),DA(2)=RADFN,DA(1)=RADTI,DA=RACNI,DIE="^RADPT("_DA(2)_",""DT"","_DA(1)_",""P"","
     29 S DR=13_$S(RACT'="V":"",'$D(^RA(72,X,.1)):"",$P(^(.1),"^",5)'="Y":"",1:"R")_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1 "
     30 I RACT="V",($P($G(^RA(72,+X,.1)),"^",5)="Y") S DIE("NO^")="BACK"
     31 D ^DIE
     32 K DA,DE,DQ,DIE,DR
     33 I $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)="" G UNL31
     34 S DR="50///"_RACN
     35 S DR(2,70.03)=13.1
     36 S DR(3,70.14)=.01_";I $D(^RA(78.3,+X,0)),$P(^(0),""^"",4)=""y"" S RAAB=1"
     37 S DA(1)=RADFN,DA=RADTI,DIE="^RADPT("_DA(1)_",""DT"","
     38 D ^DIE
     39UNL31 ; copy then unlock
     40 N:'$D(RAPRTSET) RAPRTSET N:'$D(RAMEMARR) RAMEMARR
     41 D EN2^RAUTL20(.RAMEMARR)
     42 I RAPRTSET S RADRS=1,RAXIT=0 D COPY^RARTE2 ; copy diagnoses
     43 D UNLOCK^RAUTL12(RASAVDIE,.RASAVDA) ; use params from PrimDiag's lock
     44 K RASAVDIE,RASAVDA
     45 K DA,DE,DQ,DIE,DR
     4632 K RAXIT
     47 I $G(RAPGM)="GETRPT^RARTVER" I $E(RACT'="V"),($P(^RARPT(RARPT,0),U,14)]"") D RETURN^RARTVER2
     48PACS I (RACT="V")!(RACT="R") D TASK^RAHLO4
     49 I RACT="V",$T(CREATE^WVRALINK)]"" D CREATE^WVRALINK(RADFN,RADTI,RACNI) ;women's health
     50 ;
     51 I RAPGM="NXT^RABTCH1" G @RAPGM
     52TIME D:RACT="V"
     53 .N RAHLTCPB S RAHLTCPB=1 D UPSTAT^RAUTL0 K RAAB
     54 I $G(RARDX)="S" D
     55 . D SAVE^RARTVER2
     56 . I $G(RAPGM)="GETRPT^RARTVER" D
     57 .. ; for 'On-line Verifying of Reports' default device selection is the
     58 .. ; "REPORT PRINTER NAME"
     59 .. S %ZIS("B")=$P($G(RAMLC),"^",10) K:%ZIS("B")']"" %ZIS("B")
     60 .. Q
     61 . D Q^RARTR,RESTORE^RARTVER2
     62 . K:$D(%ZIS("B")) %ZIS("B")
     63 . Q
     64 G @RAPGM
     65Q K %,%DT,%X,C,D,D0,D1,DA,DIC,RACN,RACNI,RACT,RADATE,RADFN,RADTE,RADTI,RADUZ,RAHEAD,RAI,RAIMGTYI,RAIMGTYJ,RANME,RANUM,RAOR,RAPGM,RAPRC,RAQUIT,RAREPORT,RARPT,RASET,RASN,RASSN,RAST,RASTI,RAUP,RAVER,X,Y,^TMP($J,"RAEX")
     66 K %W,%Y,%Y1,DDER,DI,DIROUT,DIRUT,DLAYGO,DTOUT,DUOUT,RACI,ZTSK,POP,DDH
     67 Q
     68OERR1 ; Jump to 'OERR1^RART1' This is necessary to support the reference to
     69 ; this line label in the OE/RR Notifications file.
     70 G OERR1^RART1 Q
     71 ;
     72PRTDX ; print dx codes on report display (called from RART1)
     73 K RAFLG D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF))
     74 Q:X="^"!(X="T")!(X="P")
     75 S RADXCODE=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,13)
     76 W !?3,"Primary Diagnostic Code: ",!?2,$S($D(^RA(78.3,+RADXCODE,0)):$P(^(0),U,1),1:"") K RAFLG
     77 D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="^"!(X="T")!(X="P")
     78 I '$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX",0)) W ! Q
     79 W !!?3,"Secondary Diagnostic Codes: "
     80 S RADXCODE=0
     81 F  S RADXCODE=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"DX","B",RADXCODE)) Q:RADXCODE'>0!('$D(^RA(78.3,+RADXCODE,0)))!($D(RAOOUT))  K RAFLG D WAIT^RART1:($Y+6)>IOSL&('$D(RARTVERF)) Q:X="^"!(X="T")!(X="P")  W !?2,$P(^RA(78.3,RADXCODE,0),U,1)
     82 W !
     83 Q
     84EXIT ; Kill variables created when user prints 'Abnormal Rad/Nuc Med Report
     85 ; Alert'.  Variables are created when 'PRT^RARTR' is called.
     86 K %X,%XX,%Y,%YY,A,DDER,DFN,DI,DIR,DIW,DIWI,DIWT,DIWTC,DIWX,DLAYGO
     87 K DN,RACI,RACN0,RACPT,RACPTNDE,RADTE0,RADTV,RAN,RAOBR4,RAPRCNDE
     88 K RAPROC,RAPROCIT,RAPRV,RARPT0,VA,VADM,VAERR,X2,ZTSK
     89 Q
Note: See TracChangeset for help on using the changeset viewer.