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

    r613 r623  
    1 RARTVER ;HISC/FPT,CAH AISC/MJK,RMO-On-line Verify Reports ;11/19/97  13:52
    2         ;;5.0;Radiology/Nuclear Medicine;**8,23,26,82,56**;Mar 16, 1998;Build 3
    3         ;Supported IA #10035 ^DPT(
    4         ;Supported IA #10060 ^VA(200
    5         D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
    6         N RAVFIED,RAXIT S RAXIT=0
    7         K RAVER S:$D(^VA(200,DUZ,0)) RAVER=$P(^(0),"^") I '$D(RAVER) W !!,$C(7),"Your name must be defined in the NEW PERSON File to continue." G Q
    8         I '$D(^VA(200,"ARC","R",DUZ)),'$D(^VA(200,"ARC","S",DUZ)) W !!,$C(7),"This option is only available for Rad/Nuc Med Interpreting Physicians." G Q
    9         I '$$CHKUSR^RAO7UTL(DUZ) D ERR^RARTVER2(DUZ) D Q QUIT
    10         I $D(^VA(200,"ARC","S",DUZ)) S RASTAFF=1 G 1
    11         I $P(RAMDV,"^",18)'=1 W !!,$C(7),"Interpreting Residents are not allowed to verify reports.",!! G Q
    12 1       S RAONLINE="" W ! D ES^RASIGU G Q:'%
    13         I $D(RASTAFF),$P($G(^VA(200,DUZ,"RA")),U,2)'="y" S RARAD=DUZ,RAD="ASTF",RARESFLG="" G SRTRPT ;selected USER does NOT have ALLOW VERIFYING OF OTHERS
    14         I '$D(^VA(200,"ARC","S",DUZ)),$S('$P(RAMDV,"^",18):1,'$D(^VA(200,"ARC","R",DUZ)):1,'$D(^VA(200,DUZ,"RA")):1,$P(^VA(200,DUZ,"RA"),"^",2)'="y":1,1:0) S RARAD=DUZ,RAD="ARES",RARESFLG="" G SRTRPT
    15 ASKRAD  W ! S DIC("B")=RAVER,DIC("S")="I $D(^VA(200,""ARC"",""R"",Y))!($D(^VA(200,""ARC"",""S"",Y)))",DIC("A")="Select Interpreting Physician: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC G Q:Y<0 S RARAD=+Y
    16         S RAD=$S($D(^VA(200,"ARC","R",RARAD)):"ARES",1:"ASTF")
    17         ;
    18 SRTRPT  K ^TMP($J,"RA"),RA,RARPTX
    19         S RARADHLD=RARAD,RATOT=0,RARPT=0
    20         ;tmp($j,"ra","dt",-,-) =
    21         ;^rpt status at start of selection^/long CN^Pat.ien^Proc.ien
    22         F  S RARPT=$O(^RARPT(RAD,RARAD,RARPT)) Q:'RARPT  I $D(^RARPT(RARPT,0)) S RARTDT=$S($P(^(0),"^",6)="":9999999.9999,1:$P(^(0),"^",6)) D
    23         .Q:$$STUB^RAEDCN1(RARPT)  ;skip stub report 081500
    24         .Q:"^V^EF^"[("^"_$P($G(^RARPT(+RARPT,0)),"^",5)_"^")  ;skip 'V' & "EF'
    25         .S Y=RARPT D RASET^RAUTL2 ;returns Y=radpt(radfn,"dt",radti,"p",-,0)
    26         .Q:'Y  ;record must be corrupt no zero node for ADC x-ref!!
    27         .S ^TMP($J,"RA","DT",RARTDT,RARPT)="^"_$P($G(^RARPT(+RARPT,0)),"^",5)_"^/"_$P(^(0),"^",1,2)_"^"_+$P(Y,U,2)
    28         .S RATOT=RATOT+1
    29         .Q
    30         I 'RATOT S RANM=$S($D(^VA(200,RARAD,0)):$P(^(0),"^"),1:"UNKNOWN"),RANM=$S(RANM=RAVER:"You have",1:"Interpreting Physician "_RANM_" has") W !!,RANM," no Unverified Reports." G Q:$D(RARESFLG),ASKRAD
    31         N RATOTORI S RATOTORI=RATOT ; save original value of RATOT
    32         ;
    33 SELRPT  I RATOT=1 D ONERPT^RARTVER1 G:'$D(^TMP($J,"RA")) Q S RACHOICE=5,RACHOICE("1RPT")="" G RPTLP
    34         D TALLY^RARTVER1,SELRPT^RARTVER1 G Q:Y=0 S RACHOICE=+Y
    35         I Y=1 D PV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
    36         I Y=2 S RASTATUS="R" D DPDRNV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
    37         I Y=3 S RASTATUS="D" D DPDRNV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
    38         I Y=4 S RASTATUS="PD" D DPDRNV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
    39         I Y=5 G RPTLP
    40         I Y=7 D STAT^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
    41         ; if none of the above, then defaults to Y=6 SELECTED
    42         S RASTATFG="" D ^RARTVER1 K RASTATFG G Q:$D(RAOUT)!('$D(RARPTX))
    43         ;
    44 RPTLP   S DIR(0)="S^P:PAGE AT A TIME;E:ENTIRE REPORT",DIR("B")="P",DIR("A")="How would you like to view the reports?"
    45         S DIR("?",1)="If you would like to pause after each page of the report enter 'P'.",DIR("?")="Otherwise enter 'E' to view an entire report at one time."
    46         D ^DIR K DIR G Q:$D(DIRUT) I Y="E" S RARTVERF=1
    47         S RACHOICE("NAME")=$S(RACHOICE=6:"SELECTED",RACHOICE=5:"ALL",RACHOICE=4:"PROBLEM DRAFT",RACHOICE=3:"DRAFT",RACHOICE=2:"RELEASED/NOT VERIFIED",1:"PREVERIFIED")
    48 RPTLP1  I $D(^TMP($J,"RA","DT")) S RARPT=0,RARTDT=0 F  S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:'RARTDT  S RARDX="" D GETRPT Q:RARDX="^"  I $D(RARLTV),$G(RARLTV)=0 D ADDLRPT^RARTVER2 Q:RATOT=0  S RARLTV=RATOT G RPTLP1
    49         I $D(^TMP($J,"RA","XREF")) S (RPTX,RARPT)=0 D GETRPT
    50         ; RARESFLG  is used to flag that  VERIFYING OF OTHERS  is allowed
    51         ; Before looping back, RARESFLG is set, so that if there are no reports,
    52         ; the logic will goto Q instead of to ASKRAD
    53         I RATOTORI>1 S RARAD=RARADHLD,RARESFLG="" K RARLTV,RARTVERF G SRTRPT ; go another round
    54         ; also dis-allow re-asking another USER when all reports
    55         ; become verified by current USER
    56         ;
    57 Q       D CU^RARTVER2
    58         Q
    59         ;
    60 GETRPT  I $G(RARPT) L -^RARPT(RARPT)
    61         S:$D(^TMP($J,"RA","XREF")) RPTX=RPTX+1 S RARPT=$S($D(^TMP($J,"RA","DT")):$O(^TMP($J,"RA","DT",RARTDT,RARPT)),$D(^TMP($J,"RA","XREF")):+$G(RARPTX(RPTX)),1:0) Q:'RARPT
    62         I $D(^TMP($J,"RA","DT")) G:$P(^TMP($J,"RA","DT",RARTDT,RARPT),"^")="V" GETRPT S $P(^TMP($J,"RA","DT",RARTDT,RARPT),"^")="V" ;here, V = viewed already
    63         I '$D(^RARPT(RARPT)) D MSG1 G GETRPT ;rpt disappeared
    64         L +^RARPT(RARPT):2 I '$T G LOCK^RARTVER2
    65         S RAXIT=0 D DISRPT^RARTVER2 I $G(X)="^" S RARDX="^" Q  ;display whole report
    66         I +$G(RAVFIED) S RAVFIED=0 G GETRPT
    67         N RASTBEF S RASTBEF=$S($D(^TMP($J,"RA","DT",+$G(RARTDT),+$G(RARPT))):$P(^(RARPT),"^",2),$D(^TMP($J,"RA","XREF")):$P($G(RARPTX(RPTX)),U,2),1:"")
    68 ASK     Q:RAXIT  W ! S I="",$P(I,"=",80)="" W I K I
    69         I "12345"[$E(RACHOICE) D:'$D(RARLTVFL) RLTV^RARTVER1 D:$D(RARLTVFL) RLTV1^RARTVER1
    70         S RARD("A")="",RARD(1)="Print^print this report for editing",RARD(2)="Edit^edit this report",RARD(3)="Top^display the report from the beginning",RARD(4)="continue^continue normal processing"
    71         S RARD(5)="Status & Print^edit Status, then print report",RARD(0)="S",RARD("B")=4
    72         S:$G(RARLTV) RARLTV=RARLTV-1
    73         I $G(RARLTV)>0 S RARD("A")="("_$G(RARLTV)_" left to review) "
    74         I $G(RARLTV)=0 I '$D(RACHOICE("1RPT")) S RARD("A")="(No more "_RACHOICE("NAME")_") " S:RACHOICE=5 RARD("A")="(ALL gone) "
    75         S RARD("A")=RARD("A")_"Type '?' for action list, 'Enter' to " ;12/30/96
    76         I RASTBEF'=$P(^RARPT(RARPT,0),U,5) D MSG2
    77         D SET^RARD K RARD S RARDX=$E(X) I RARDX="^" L -^RARPT(RARPT) Q
    78         ; if user chose "T"op, the report will be displayed again from the top
    79         I "PT"[RARDX D PRTRPT^RARTVER2:RARDX="P",DISRPT^RARTVER2:RARDX="T" G ASK
    80         I RARDX="E" D EDTCHK^RARTVER2 I RARDX="E" W !!,"EDITING REPORT",!,"--------------",! D EDTRPT^RARTE1 D  K RAAB G ASK
    81         .; RAHLTCPB flag is inactive
    82         .N RAHLTCPB S RAHLTCPB=1 D:RACT="V" UPSTAT^RAUTL0 D:RACT'="V" UP1^RAUTL1
    83         S RAPGM="GETRPT^RARTVER" G 31^RART ;goto Verify Report Only template
    84         ;
    85 MSG1    N I,J1,J2,J3 S I=$S($D(^TMP($J,"RA","DT",+$G(RARTDT),+$G(RARPT))):^(RARPT),$D(^TMP($J,"RA","XREF")):$G(RARPTX(RPTX)),1:"")
    86         S J1=$P(I,"/",2),J2=$P(J1,"^",2),J3=$P(J1,"^",3),J1=$P(J1,"^")
    87         W !!!?15,$C(7),"Since the time you selected this group of reports,",!?15,"another user has deleted this report for",!?15,$P($G(^DPT(J2,0)),"^"),"   case ",J1,!?15,"Procedure ",$P($G(^RAMIS(71,+J3,0)),U),".",!! G CONT Q
    88 MSG2    N I,J S I=";"_$P(^RARPT(RARPT,0),"^",5)_":"
    89         S J=";"_$P(^DD(74,5,0),U,3)
    90         W !!!?15,$C(7),"Since the time you selected this group of reports,",!?15,"another user has changed this report's status to '",$P($P(J,I,2),";"),"'.",!! Q
    91 CONT    W !! S DIR(0)="FO",DIR("A")="Press return key to continue " D ^DIR
    92         Q
     1RARTVER ;HISC/FPT,CAH AISC/MJK,RMO-On-line Verify Reports ;11/19/97  13:52
     2 ;;5.0;Radiology/Nuclear Medicine;**8,23,26,82**;Mar 16, 1998;Build 8
     3 D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
     4 N RAVFIED,RAXIT S RAXIT=0
     5 K RAVER S:$D(^VA(200,DUZ,0)) RAVER=$P(^(0),"^") I '$D(RAVER) W !!,*7,"Your name must be defined in the NEW PERSON File to continue." G Q
     6 I '$D(^VA(200,"ARC","R",DUZ)),'$D(^VA(200,"ARC","S",DUZ)) W !!,*7,"This option is only available for Rad/Nuc Med Interpreting Physicians." G Q
     7 I '$$CHKUSR^RAO7UTL(DUZ) D ERR^RARTVER2(DUZ) D Q QUIT
     8 I $D(^VA(200,"ARC","S",DUZ)) S RASTAFF=1 G 1
     9 I $P(RAMDV,"^",18)'=1 W !!,*7,"Interpreting Residents are not allowed to verify reports.",!! G Q
     101 S RAONLINE="" W ! D ES^RASIGU G Q:'%
     11 I $D(RASTAFF),$P($G(^VA(200,DUZ,"RA")),U,2)'="y" S RARAD=DUZ,RAD="ASTF",RARESFLG="" G SRTRPT ;selected USER does NOT have ALLOW VERIFYING OF OTHERS
     12 I '$D(^VA(200,"ARC","S",DUZ)),$S('$P(RAMDV,"^",18):1,'$D(^VA(200,"ARC","R",DUZ)):1,'$D(^VA(200,DUZ,"RA")):1,$P(^VA(200,DUZ,"RA"),"^",2)'="y":1,1:0) S RARAD=DUZ,RAD="ARES",RARESFLG="" G SRTRPT
     13ASKRAD W ! S DIC("B")=RAVER,DIC("S")="I $D(^VA(200,""ARC"",""R"",Y))!($D(^VA(200,""ARC"",""S"",Y)))",DIC("A")="Select Interpreting Physician: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC G Q:Y<0 S RARAD=+Y
     14 S RAD=$S($D(^VA(200,"ARC","R",RARAD)):"ARES",1:"ASTF")
     15 ;
     16SRTRPT K ^TMP($J,"RA"),RA,RARPTX
     17 S RARADHLD=RARAD,RATOT=0,RARPT=0
     18 ;tmp($j,"ra","dt",-,-) =
     19 ;^rpt status at start of selection^/long CN^Pat.ien^Proc.ien
     20 F  S RARPT=$O(^RARPT(RAD,RARAD,RARPT)) Q:'RARPT  I $D(^RARPT(RARPT,0)) S RARTDT=$S($P(^(0),"^",6)="":9999999.9999,1:$P(^(0),"^",6)) D
     21 .Q:$$STUB^RAEDCN1(RARPT)  ;skip stub report 081500
     22 .Q:$P($G(^RARPT(+RARPT,0)),"^",5)="V"  ; skip if already verified
     23 .S Y=RARPT D RASET^RAUTL2 ;returns Y=radpt(radfn,"dt",radti,"p",-,0)
     24 .Q:'Y  ;record must be corrupt no zero node for ADC x-ref!!
     25 .S ^TMP($J,"RA","DT",RARTDT,RARPT)="^"_$P($G(^RARPT(+RARPT,0)),"^",5)_"^/"_$P(^(0),"^",1,2)_"^"_+$P(Y,U,2)
     26 .S RATOT=RATOT+1
     27 .Q
     28 I 'RATOT S RANM=$S($D(^VA(200,RARAD,0)):$P(^(0),"^"),1:"UNKNOWN"),RANM=$S(RANM=RAVER:"You have",1:"Interpreting Physician "_RANM_" has") W !!,RANM," no Unverified Reports." G Q:$D(RARESFLG),ASKRAD
     29 N RATOTORI S RATOTORI=RATOT ; save original value of RATOT
     30 ;
     31SELRPT I RATOT=1 D ONERPT^RARTVER1 G:'$D(^TMP($J,"RA")) Q S RACHOICE=5,RACHOICE("1RPT")="" G RPTLP
     32 D TALLY^RARTVER1,SELRPT^RARTVER1 G Q:Y=0 S RACHOICE=+Y
     33 I Y=1 D PV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
     34 I Y=2 S RASTATUS="R" D DPDRNV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
     35 I Y=3 S RASTATUS="D" D DPDRNV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
     36 I Y=4 S RASTATUS="PD" D DPDRNV^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
     37 I Y=5 G RPTLP
     38 I Y=7 D STAT^RARTVER1 G:RATOT'>0 SRTRPT G RPTLP
     39 ; if none of the above, then defaults to Y=6 SELECTED
     40 S RASTATFG="" D ^RARTVER1 K RASTATFG G Q:$D(RAOUT)!('$D(RARPTX))
     41 ;
     42RPTLP S DIR(0)="S^P:PAGE AT A TIME;E:ENTIRE REPORT",DIR("B")="P",DIR("A")="How would you like to view the reports?"
     43 S DIR("?",1)="If you would like to pause after each page of the report enter 'P'.",DIR("?")="Otherwise enter 'E' to view an entire report at one time."
     44 D ^DIR K DIR G Q:$D(DIRUT) I Y="E" S RARTVERF=1
     45 S RACHOICE("NAME")=$S(RACHOICE=6:"SELECTED",RACHOICE=5:"ALL",RACHOICE=4:"PROBLEM DRAFT",RACHOICE=3:"DRAFT",RACHOICE=2:"RELEASED/NOT VERIFIED",1:"PREVERIFIED")
     46RPTLP1 I $D(^TMP($J,"RA","DT")) S RARPT=0,RARTDT=0 F  S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:'RARTDT  S RARDX="" D GETRPT Q:RARDX="^"  I $D(RARLTV),$G(RARLTV)=0 D ADDLRPT^RARTVER2 Q:RATOT=0  S RARLTV=RATOT G RPTLP1
     47 I $D(^TMP($J,"RA","XREF")) S (RPTX,RARPT)=0 D GETRPT
     48 ; RARESFLG  is used to flag that  VERIFYING OF OTHERS  is allowed
     49 ; Before looping back, RARESFLG is set, so that if there are no reports,
     50 ; the logic will goto Q instead of to ASKRAD
     51 I RATOTORI>1 S RARAD=RARADHLD,RARESFLG="" K RARLTV,RARTVERF G SRTRPT ; go another round
     52 ; also dis-allow re-asking another USER when all reports
     53 ; become verified by current USER
     54 ;
     55Q D CU^RARTVER2
     56 Q
     57 ;
     58GETRPT I $G(RARPT) L -^RARPT(RARPT)
     59 S:$D(^TMP($J,"RA","XREF")) RPTX=RPTX+1 S RARPT=$S($D(^TMP($J,"RA","DT")):$O(^TMP($J,"RA","DT",RARTDT,RARPT)),$D(^TMP($J,"RA","XREF")):+$G(RARPTX(RPTX)),1:0) Q:'RARPT
     60 I $D(^TMP($J,"RA","DT")) G:$P(^TMP($J,"RA","DT",RARTDT,RARPT),"^")="V" GETRPT S $P(^TMP($J,"RA","DT",RARTDT,RARPT),"^")="V" ;here, V = viewed already
     61 I '$D(^RARPT(RARPT)) D MSG1 G GETRPT ;rpt disappeared
     62 L +^RARPT(RARPT):2 I '$T G LOCK^RARTVER2
     63 S RAXIT=0 D DISRPT^RARTVER2 I $G(X)="^" S RARDX="^" Q  ;display whole report
     64 I +$G(RAVFIED) S RAVFIED=0 G GETRPT
     65 N RASTBEF S RASTBEF=$S($D(^TMP($J,"RA","DT",+$G(RARTDT),+$G(RARPT))):$P(^(RARPT),"^",2),$D(^TMP($J,"RA","XREF")):$P($G(RARPTX(RPTX)),U,2),1:"")
     66ASK Q:RAXIT  W ! S I="",$P(I,"=",80)="" W I K I
     67 I "12345"[$E(RACHOICE) D:'$D(RARLTVFL) RLTV^RARTVER1 D:$D(RARLTVFL) RLTV1^RARTVER1
     68 S RARD("A")="",RARD(1)="Print^print this report for editing",RARD(2)="Edit^edit this report",RARD(3)="Top^display the report from the beginning",RARD(4)="continue^continue normal processing"
     69 S RARD(5)="Status & Print^edit Status, then print report",RARD(0)="S",RARD("B")=4
     70 S:$G(RARLTV) RARLTV=RARLTV-1
     71 I $G(RARLTV)>0 S RARD("A")="("_$G(RARLTV)_" left to review) "
     72 I $G(RARLTV)=0 I '$D(RACHOICE("1RPT")) S RARD("A")="(No more "_RACHOICE("NAME")_") " S:RACHOICE=5 RARD("A")="(ALL gone) "
     73 S RARD("A")=RARD("A")_"Type '?' for action list, 'Enter' to " ;12/30/96
     74 I RASTBEF'=$P(^RARPT(RARPT,0),U,5) D MSG2
     75 D SET^RARD K RARD S RARDX=$E(X) I RARDX="^" L -^RARPT(RARPT) Q
     76 ; if user chose "T"op, the report will be displayed again from the top
     77 I "PT"[RARDX D PRTRPT^RARTVER2:RARDX="P",DISRPT^RARTVER2:RARDX="T" G ASK
     78 I RARDX="E" D EDTCHK^RARTVER2 I RARDX="E" W !!,"EDITING REPORT",!,"--------------",! D EDTRPT^RARTE1 D  K RAAB G ASK
     79 .; RAHLTCPB flag is inactive
     80 .N RAHLTCPB S RAHLTCPB=1 D:RACT="V" UPSTAT^RAUTL0 D:RACT'="V" UP1^RAUTL1
     81 S RAPGM="GETRPT^RARTVER" G 31^RART ;goto Verify Report Only template
     82 ;
     83MSG1 N I,J1,J2,J3 S I=$S($D(^TMP($J,"RA","DT",+$G(RARTDT),+$G(RARPT))):^(RARPT),$D(^TMP($J,"RA","XREF")):$G(RARPTX(RPTX)),1:"")
     84 S J1=$P(I,"/",2),J2=$P(J1,"^",2),J3=$P(J1,"^",3),J1=$P(J1,"^")
     85 W !!!?15,*7,"Since the time you selected this group of reports,",!?15,"another user has deleted this report for",!?15,$P($G(^DPT(J2,0)),"^"),"   case ",J1,!?15,"Procedure ",$P($G(^RAMIS(71,+J3,0)),U),".",!! G CONT Q
     86MSG2 N I,J S I=";"_$P(^RARPT(RARPT,0),"^",5)_":"
     87 S J=";"_$P(^DD(74,5,0),U,3)
     88 W !!!?15,*7,"Since the time you selected this group of reports,",!?15,"another user has changed this report's status to '",$P($P(J,I,2),";"),"'.",!! Q
     89CONT W !! S DIR(0)="FO",DIR("A")="Press return key to continue " D ^DIR
     90 Q
Note: See TracChangeset for help on using the changeset viewer.