- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTRPV.m
r613 r623 1 RARTRPV ;HISC/FPT-Resident Pre-Verify Report ;10/3/97 15:54 2 ;;5.0;Radiology/Nuclear Medicine;**26,56**;Mar 16, 1998;Build 3 3 ;Supported IA #10104 REPEAT^XLFSTR 4 ;Supported IA #10035 ^DPT( 5 ;Supported IA #10060 and 2056 GET1^DIQ of file 200 6 ;Supported IA #10076 ^XUSEC 7 N DIERR 8 D SET^RAPSET1 I $D(XQUIT) K XQUIT Q 9 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 10 I '$D(^VA(200,"ARC","R",DUZ)) W !!,$C(7),"You are not classified as a Rad/Nuc Med Interpreting Resident." G Q 11 S RAINACT=$$GET1^DIQ(200,DUZ_",",53.4,"I") ; grab Inactive Date (if any) 12 I RAINACT,(RAINACT'>DT) W !!,$C(7),"You are not classified as an active Rad/Nuc Med Interpreting Resident." K RAINACT G Q 13 K RAINACT S RAONLINE="" W ! D ES^RASIGU G Q:'% 14 S RARAD=DUZ,RAD="ARES" 15 ; 16 SRTRPT K RA,RARPTX,^TMP($J,"RA") S (RATOT,RARPT)=0 17 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)) I $P(^RARPT(RARPT,0),U,12)="" D 18 .Q:$$STUB^RAEDCN1(RARPT) ;skip stub report 031501 19 .Q:"^V^EF^"[("^"_$P($G(^RARPT(+RARPT,0)),"^",5)_"^") ;skip if V or EF 20 .S ^TMP($J,"RA","DT",RARTDT,RARPT)="" 21 .S RATOT=RATOT+1 22 I 'RATOT W !!,"You have no Unverified Reports." G Q 23 ; 24 SELRPT S RARD("A")="Do you wish to review "_$S(RATOT=1:"this one report",1:"all "_RATOT_" reports")_"? ",RARD(1)="Yes^review all reports",RARD(2)="No^choose which reports to review",RARD("B")=1,RARD(0)="S" 25 D SET^RARD K RARD S X=$E(X) G Q:X["^"!(X="N"&(RATOT=1)),RPTLP:X="Y" D ^RARTVER1 G Q:$D(RAOUT)!('$D(RARPTX)) 26 ; 27 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?" 28 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." 29 D ^DIR K DIR G Q:$D(DIRUT) I Y="E" S RARTVERF=1 30 I $D(^TMP($J,"RA","DT")) S RARPT=0 F RARTDT=0:0 S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:'RARTDT S RARDX="" D GETRPT Q:RARDX="^" 31 I $D(^TMP($J,"RA","XREF")) S (RPTX,RARPT)=0 D GETRPT 32 ; 33 Q K %,%DT,%W,%Y1,DA,DGO,DI,DIC,DIWF,DIWR,I,OREND,POP,RA,RACN,RACNI,RACS,RACT,RAD,RADATE,RADFN,RADIV,RADTE,RADTI,RADUP,RADUZ,RAERR,RAFLG,RAIMGTYJ,RAJ1,RAPRIT,RANM,RANME,RANUM,RAONLINE,RAOR,RAOUT,RAPRC,RARAD,RARDX,RARPDT,RARPT 34 K RARPTX,RARTDT,RARTVER,RARTVERF,RASET,RASIG,RASN,RASTI,RATOT,RAVER,RAVNB,RAXIT,RAXX,RPTX,X,Y,^TMP($J,"RA") 35 K %X,D,D0,D1,DDER,DDH,DLAYGO 36 K C,DIRUT,DUOUT,HLN,HLRESLT,HLSAN,J,RADFLDS,RAPRTSET,X1 37 Q 38 ; 39 GETRPT I $G(RARPT) L -^RARPT(RARPT) 40 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 L +^RARPT(RARPT):2 G:'$T LOCK G:$P($G(^RARPT(RARPT,0)),U,5)="V" VER 41 D DISRPT 42 I RAIMGTYJ']"" D Q 43 . I $G(RARPT) L -^RARPT(RARPT) 44 . Q 45 ASK W !,$$REPEAT^XLFSTR("=",80) 46 S 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" 47 S RARD(5)="Status & Print^edit Status, then print report",RARD("B")=4,RARD(0)="S" 48 D SET^RARD K RARD S RARDX=$E(X) I RARDX="^" L -^RARPT(RARPT) Q 49 I "PT"[RARDX D PRTRPT:RARDX="P",DISRPT:RARDX="T" G ASK 50 I RARDX="E" D EDTCHK I RARDX="E" D G ASK 51 .W !!,"EDITING REPORT",!,"--------------",! 52 .D EDTRPT^RARTRPV1 53 .D:RACT'="V" UP1^RAUTL1 54 .I $D(DTOUT) K ^TMP($J,"RA") 55 .Q 56 G NOEDIT^RARTRPV1 ;pre-verify report, no report text edit 57 ; 58 DISRPT S (RAIMGTYJ,RARTVER)="" D RASET Q:'Y!(RAIMGTYJ']"") D DISP^RART1 K RARTVER 59 Q 60 PRTRPT D SAVE^RARTVER2 61 S ION=$P(RAMLC,"^",10),IOP=$S(ION]"":"Q;"_ION,1:"Q") 62 S RAMES="W !!,""Report has been queued for printing on device "",ION,"".""" D Q^RARTR 63 D RESTORE^RARTVER2 64 Q 65 ; 66 RASET S Y=RARPT D RASET^RAUTL2 Q:'Y 67 S Y(0)=Y,RANME=$S($D(^DPT(RADFN,0)):$P(^(0),"^"),1:"UNKNOWN") 68 S RAPRC=$S($D(^RAMIS(71,+$P(Y(0),"^",2),0)):$P(^(0),"^"),1:"UNKNOWN") 69 S RAIMGTYJ=$$IMGTY^RAUTL12("e",RADFN,RADTI) 70 I RAIMGTYJ']"" D 71 . W !?5,"Imaging Type data appears to be missing for this exam.",$C(7) 72 . Q 73 Q 74 LOCK S RACN=+$P(^RARPT(RARPT,0),"^",4) 75 W !!,$C(7),"Another user is editing this report",$S($G(RACN)]"":" (Case # "_RACN_")",1:""),". Please try again later." H 4 K RACN G GETRPT 76 Q 77 VER ; report was verified since tmp global was built 78 S RACN=$G(^RARPT(RARPT,0)) 79 S RACN("CASE")=+$P(RACN,U,4) 80 S RACN("PAT")=+$P(RACN,U,2) 81 S RACN("VER")=+$P(RACN,U,9) 82 W !!,$C(7),$$GET1^DIQ(200,+RACN("VER")_",",.01)_" verified report for "_$P(^DPT(RACN("PAT"),0),U) 83 W !,"(Case # "_RACN("CASE")_") since you began this option." 84 H 4 K RACN G GETRPT 85 Q 86 EDTCHK ; is user permitted to edit report 87 S RASTATUS=+$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",3) 88 I $P($G(^RA(72,RASTATUS,0)),"^",3)>0 K RASTATUS Q 89 K RASTATUS 90 I $D(^XUSEC("RA MGR",DUZ)) Q 91 I $P(RAMDV,"^",22)=1 Q 92 W $C(7),!!,"The STATUS for this case is CANCELLED. You may not enter a report.",!! 93 S RARDX="C" ;Reset RARDX so user can only verify. 94 Q 1 RARTRPV ;HISC/FPT-Resident Pre-Verify Report ;10/3/97 15:54 2 ;;5.0;Radiology/Nuclear Medicine;**26**;Mar 16, 1998 3 D SET^RAPSET1 I $D(XQUIT) K XQUIT Q 4 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 5 I '$D(^VA(200,"ARC","R",DUZ)) W !!,*7,"You are not classified as a Rad/Nuc Med Interpreting Resident." G Q 6 S RAINACT=$P($G(^VA(200,DUZ,"PS")),"^",4) ; grab Inactive Date (if any) 7 I RAINACT,(RAINACT'>DT) W !!,$C(7),"You are not classified as an active Rad/Nuc Med Interpreting Resident." K RAINACT G Q 8 K RAINACT S RAONLINE="" W ! D ES^RASIGU G Q:'% 9 S RARAD=DUZ,RAD="ARES" 10 ; 11 SRTRPT K RA,RARPTX,^TMP($J,"RA") S (RATOT,RARPT)=0 12 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)) I $P(^RARPT(RARPT,0),U,12)="" D 13 .Q:$$STUB^RAEDCN1(RARPT) ;skip stub report 031501 14 .Q:$P($G(^RARPT(+RARPT,0)),"^",5)="V" ;skip if already verified 031501 15 .S ^TMP($J,"RA","DT",RARTDT,RARPT)="" 16 .S RATOT=RATOT+1 17 I 'RATOT W !!,"You have no Unverified Reports." G Q 18 ; 19 SELRPT S RARD("A")="Do you wish to review "_$S(RATOT=1:"this one report",1:"all "_RATOT_" reports")_"? ",RARD(1)="Yes^review all reports",RARD(2)="No^choose which reports to review",RARD("B")=1,RARD(0)="S" 20 D SET^RARD K RARD S X=$E(X) G Q:X["^"!(X="N"&(RATOT=1)),RPTLP:X="Y" D ^RARTVER1 G Q:$D(RAOUT)!('$D(RARPTX)) 21 ; 22 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?" 23 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." 24 D ^DIR K DIR G Q:$D(DIRUT) I Y="E" S RARTVERF=1 25 I $D(^TMP($J,"RA","DT")) S RARPT=0 F RARTDT=0:0 S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:'RARTDT S RARDX="" D GETRPT Q:RARDX="^" 26 I $D(^TMP($J,"RA","XREF")) S (RPTX,RARPT)=0 D GETRPT 27 ; 28 Q K %,%DT,%W,%Y1,DA,DGO,DI,DIC,DIWF,DIWR,I,OREND,POP,RA,RACN,RACNI,RACS,RACT,RAD,RADATE,RADFN,RADIV,RADTE,RADTI,RADUP,RADUZ,RAERR,RAFLG,RAIMGTYJ,RAJ1,RAPRIT,RANM,RANME,RANUM,RAONLINE,RAOR,RAOUT,RAPRC,RARAD,RARDX,RARPDT,RARPT 29 K RARPTX,RARTDT,RARTVER,RARTVERF,RASET,RASIG,RASN,RASTI,RATOT,RAVER,RAVNB,RAXIT,RAXX,RPTX,X,Y,^TMP($J,"RA") 30 K %X,D,D0,D1,DDER,DDH,DLAYGO 31 K C,DIRUT,DUOUT,HLN,HLRESLT,HLSAN,J,RADFLDS,RAPRTSET,X1 32 Q 33 ; 34 GETRPT I $G(RARPT) L -^RARPT(RARPT) 35 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 L +^RARPT(RARPT):2 G:'$T LOCK G:$P($G(^RARPT(RARPT,0)),U,5)="V" VER 36 D DISRPT 37 I RAIMGTYJ']"" D Q 38 . I $G(RARPT) L -^RARPT(RARPT) 39 . Q 40 ASK W !,$$REPEAT^XLFSTR("=",80) 41 S 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" 42 S RARD(5)="Status & Print^edit Status, then print report",RARD("B")=4,RARD(0)="S" 43 D SET^RARD K RARD S RARDX=$E(X) I RARDX="^" L -^RARPT(RARPT) Q 44 I "PT"[RARDX D PRTRPT:RARDX="P",DISRPT:RARDX="T" G ASK 45 I RARDX="E" D EDTCHK I RARDX="E" D G ASK 46 .W !!,"EDITING REPORT",!,"--------------",! 47 .D EDTRPT^RARTRPV1 48 .D:RACT'="V" UP1^RAUTL1 49 .I $D(DTOUT) K ^TMP($J,"RA") 50 .Q 51 G NOEDIT^RARTRPV1 ;pre-verify report, no report text edit 52 ; 53 DISRPT S (RAIMGTYJ,RARTVER)="" D RASET Q:'Y!(RAIMGTYJ']"") D DISP^RART1 K RARTVER 54 Q 55 PRTRPT D SAVE^RARTVER2 56 S ION=$P(RAMLC,"^",10),IOP=$S(ION]"":"Q;"_ION,1:"Q") 57 S RAMES="W !!,""Report has been queued for printing on device "",ION,"".""" D Q^RARTR 58 D RESTORE^RARTVER2 59 Q 60 ; 61 RASET S Y=RARPT D RASET^RAUTL2 Q:'Y 62 S Y(0)=Y,RANME=$S($D(^DPT(RADFN,0)):$P(^(0),"^"),1:"UNKNOWN") 63 S RAPRC=$S($D(^RAMIS(71,+$P(Y(0),"^",2),0)):$P(^(0),"^"),1:"UNKNOWN") 64 S RAIMGTYJ=$$IMGTY^RAUTL12("e",RADFN,RADTI) 65 I RAIMGTYJ']"" D 66 . W !?5,"Imaging Type data appears to be missing for this exam.",$C(7) 67 . Q 68 Q 69 LOCK S RACN=+$P(^RARPT(RARPT,0),"^",4) 70 W !!,*7,"Another user is editing this report",$S($G(RACN)]"":" (Case # "_RACN_")",1:""),". Please try again later." H 4 K RACN G GETRPT 71 Q 72 VER ; report was verified since tmp global was built 73 S RACN=$G(^RARPT(RARPT,0)) 74 S RACN("CASE")=+$P(RACN,U,4) 75 S RACN("PAT")=+$P(RACN,U,2) 76 S RACN("VER")=+$P(RACN,U,9) 77 W !!,*7,$P($G(^VA(200,+RACN("VER"),0)),U)_" verified report for "_$P(^DPT(RACN("PAT"),0),U) 78 W !,"(Case # "_RACN("CASE")_") since you began this option." 79 H 4 K RACN G GETRPT 80 Q 81 EDTCHK ; is user permitted to edit report 82 S RASTATUS=+$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",3) 83 I $P($G(^RA(72,RASTATUS,0)),"^",3)>0 K RASTATUS Q 84 K RASTATUS 85 I $D(^XUSEC("RA MGR",DUZ)) Q 86 I $P(RAMDV,"^",22)=1 Q 87 W *7,!!,"The STATUS for this case is CANCELLED. You may not enter a report.",!! 88 S RARDX="C" ;Reset RARDX so user can only verify. 89 Q
Note:
See TracChangeset
for help on using the changeset viewer.
