source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL19C.m@ 775

Last change on this file since 775 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1RAUTL19C ;HISC/GJC-Utility Routine ;10/29/97 12:42
2 ;;5.0;Radiology/Nuclear Medicine;**10**;Mar 16, 1998
3 ;
4EN1 ; Check data consistency
5 N I,J,RAERR,RAFLG,RAIEN,RANO,RANODE,RAO,RAPIECE,RAYES,RAWATERR,RACHKERR
6 S RAERR=0,RANO="Nn",RAYES="Yy",RACHKERR=0,RAWATERR=0 D HEAD^RAUTL11
7 S RAO="" F S RAO=$O(^RA(72,"AA",RAIMG,RAO)) Q:RAO']"" D Q:RAOUT
8 . S RAIEN=0
9 . F S RAIEN=+$O(^RA(72,"AA",RAIMG,RAO,RAIEN)) Q:'RAIEN D Q:RAOUT
10 .. S RANODE(0)=$G(^RA(72,RAIEN,0)),RANODE(.1)=$G(^(.1)),RANODE(.2)=$G(^(.2)),RANODE(.5)=$G(^(.5)),RANODE(.6)=$G(^(.6))
11 .. ; let rapiece(.25)=$p(ranode(.2),"^",5), etc
12 .. K RAPIECE
13 .. F I=.11,.111,.116,.12,.14,.15,.16,.21,.22,.24,.25,.26,.27,.28,.51,.53,.54,.55,.57,.58,.59,.61,.63,.64,.65,.67,.68,.69,.611,.113,.114,.213,.214 S RAPIECE(I)=$P(RANODE($E(I,1,2)),"^",$E(I,3,$L(I)))
14 .. I $P(RANODE(0),U,3)=1 D CKWAIT Q:RAOUT
15 .. ; if REQUIRED fld=Y, its corresp ASK fld must be Y at same/lower status
16 .. ; field .11<->field .21, .12<->.22, .14<->.24, .15<->.25, .16<->.26
17 .. ; .51<->.61, .53<->.63, .54<->.64
18 .. ; .55<->.65, .58<->.68, .59<->.69
19 .. F I=.11,.12,.14,.15,.16,.51,.53,.54,.55,.58,.59,.113,.114 S J=I+.1 D CKPAIR Q:RAOUT
20 .. Q:RAOUT
21 .. ; ASK PHARM ADM DT/TIME/PERSON must be Y before ASK PHARM & DOSAGE=Y
22 .. S I=.28,J=.27 D CKPAIR
23 .. Q:RAOUT
24 .. ; if IMPRESSION is required, then REPORT should also be required
25 .. I $$UP^XLFSTR(RAPIECE(.116))="Y",$$UP^XLFSTR(RAPIECE(.111))'="Y" D
26 ... W !!?5,"<WARNING> -- Within "_RAIMG_", exam status '"_$P(RANODE(0),"^")_"'"
27 ... W !?5,"Impression is required, but a report is not, so an exam"
28 ... W !?5,"will be able to reach this status without a report.",!?5
29 ... W "But if a report is entered, an impression will be required.",!
30 ... Q
31 .. ; other Radiopharm flds must be Y before ASK RADIOPHARM & DOSAGES=Y
32 .. S J=.61 F I=.53,.54,.57,.58,.59,.63,.64,.65,.67,.68,.69 D CKPAIR Q:RAOUT
33 .. Q:RAOUT
34 .. ; if print dosage ticket is Y, then all required flds on ticket s/b Y
35 .. S I=.611 F J=.51,.53,.54,.58 D CKPAIR Q:RAOUT
36 .. I RAPIECE(.611)="Y" D CKPRNTR^RAUTL19 Q:RAOUT
37 .. I $P(^RA(79.2,$P(RANODE(0),U,7),0),U,5)'["Y" D NOTNEED^RAUTL19
38 .. Q
39 . Q
40 Q:RAOUT
41 D CKCOMP^RAUTL19B(RAIMG) Q:RAOUT
42 D CKREQD^RAUTL19B(RAIMG) Q:RAOUT
43 D CKOTHER^RAUTL19A(RAIMG) Q:RAOUT
44 ; 'XAMORD^RAMAIN1' hit twice: once for the screen, once for hardcopy
45 D XAMORD^RAMAIN1 Q:RAOUT
46 I 'RAERR,'RAORDXST D Q:RAOUT
47 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
48 . W !!?(IOM-$L(RANOERR)\2),RANOERR
49 . Q
50 S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
51 Q
52CKPAIR ; when field I is Y, then field J must also be Y at current/lower status
53 S RAFLG=0
54 ; don't check length of rapiece(j) because we need to treat null as 'no'
55 I $L(RAPIECE(I)),(RAYES[RAPIECE(I)),(RANO[RAPIECE(J)) D
56 . ; check fields, get field text from Field Title in Data Dictionary
57 . S RAFLG=$$ASKPRI^RAUTL19(RAIMG,RAO,J) Q:RAFLG S RAERR=1 D WRPAIR^RAUTL19
58 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
59 . W !!?5,"Within "_RAIMG_", exam status '"_$P(RANODE(0),"^")_"'"
60 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
61 . W !?5,"order ("_RAO_") '"_$P($G(^DD(72,I,.1)),U)_"' is set to 'Yes'"
62 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
63 . W !?5,"but '"_$P($G(^DD(72,J,.1)),U)_"' is set to 'No'"
64 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
65 . W !?5,"in this status and all lower active statuses."
66 . Q
67 Q
68CKWAIT ; CKWAIT is only done for WAITING FOR EXAM and assumes order seq = 1
69 F I=.111,.112,.116,.211,.23 S RAPIECE(I)=$P(RANODE($E(I,1,2)),"^",$E(I,3,$L(I)))
70 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
71 S I=.2 F S I=$O(RAPIECE(I)) Q:I>.29 Q:I="" S J=$$UP^XLFSTR(RAPIECE(I)) I J="Y" D WRWAIT^RAUTL19 W !?5,"'",$P($G(^DD(72,I,.1)),U),"'" S RAERR=1 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
72 Q:RAOUT
73 S I=.6 F S I=$O(RAPIECE(I)) Q:I>.69 Q:I="" S J=$$UP^XLFSTR(RAPIECE(I)) I J="Y" D WRWAIT^RAUTL19 W !?5,"'",$P($G(^DD(72,I,.1)),U),"'" S RAERR=1 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
74 Q:RAOUT
75 S I=.1 F S I=$O(RAPIECE(I)) Q:I>.19 Q:I="" S J=$$UP^XLFSTR(RAPIECE(I)) I J="Y" D WRWAIT^RAUTL19 W !?5,"'",$P($G(^DD(72,I,.1)),U),"'" S RAERR=1 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
76 Q:RAOUT
77 S I=.5 F S I=$O(RAPIECE(I)) Q:I>.59 Q:I="" S J=$$UP^XLFSTR(RAPIECE(I)) I J="Y" D WRWAIT^RAUTL19 W !?5,"'",$P($G(^DD(72,I,.1)),U),"'" S RAERR=1 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
78 W:RAERR !!?5,"The above fields need not be answered for the ",$P(RANODE(0),U)," status.",!?5,"The system automatically sets newly registered cases to this status",!?5,"even if they don't meet all these requirements."
79 I $$UP^XLFSTR(RAPIECE(.611))="Y" D WRWAIT^RAUTL19 W !!?5,"'",$P($G(^DD(72,.611,.1)),U),"' should NOT be Y",!,?5,"for status of ",$P(RANODE(0),U) S RAERR=1 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HEAD^RAUTL11
80 Q
Note: See TracBrowser for help on using the repository browser.