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

RAUTL19C ;HISC/GJC-Utility Routine ;10/29/97  12:42
 ;;5.0;Radiology/Nuclear Medicine;**10**;Mar 16, 1998
 ;
EN1 ; Check data consistency
 N I,J,RAERR,RAFLG,RAIEN,RANO,RANODE,RAO,RAPIECE,RAYES,RAWATERR,RACHKERR
 S RAERR=0,RANO="Nn",RAYES="Yy",RACHKERR=0,RAWATERR=0 D HEAD^RAUTL11
 S RAO="" F  S RAO=$O(^RA(72,"AA",RAIMG,RAO)) Q:RAO']""  D  Q:RAOUT
 . S RAIEN=0
 . F  S RAIEN=+$O(^RA(72,"AA",RAIMG,RAO,RAIEN)) Q:'RAIEN  D  Q:RAOUT
 .. S RANODE(0)=$G(^RA(72,RAIEN,0)),RANODE(.1)=$G(^(.1)),RANODE(.2)=$G(^(.2)),RANODE(.5)=$G(^(.5)),RANODE(.6)=$G(^(.6))
 .. ; let rapiece(.25)=$p(ranode(.2),"^",5), etc
 .. K RAPIECE
 .. 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)))
 .. I $P(RANODE(0),U,3)=1 D CKWAIT Q:RAOUT
 .. ; if REQUIRED fld=Y, its corresp ASK fld must be Y at same/lower status
 .. ; field .11<->field .21, .12<->.22, .14<->.24, .15<->.25, .16<->.26
 .. ; .51<->.61, .53<->.63, .54<->.64
 .. ; .55<->.65, .58<->.68, .59<->.69
 .. F I=.11,.12,.14,.15,.16,.51,.53,.54,.55,.58,.59,.113,.114 S J=I+.1 D CKPAIR Q:RAOUT
 .. Q:RAOUT
 .. ; ASK PHARM ADM DT/TIME/PERSON must be Y before ASK PHARM & DOSAGE=Y
 .. S I=.28,J=.27 D CKPAIR
 .. Q:RAOUT
 .. ; if IMPRESSION is required, then REPORT should also be required
 .. I $$UP^XLFSTR(RAPIECE(.116))="Y",$$UP^XLFSTR(RAPIECE(.111))'="Y" D
 ... W !!?5,"<WARNING> -- Within "_RAIMG_", exam status '"_$P(RANODE(0),"^")_"'"
 ... W !?5,"Impression is required, but a report is not, so an exam"
 ... W !?5,"will be able to reach this status without a report.",!?5
 ... W "But if a report is entered, an impression will be required.",!
 ... Q
 .. ; other Radiopharm flds must be Y before ASK RADIOPHARM & DOSAGES=Y
 .. S J=.61 F I=.53,.54,.57,.58,.59,.63,.64,.65,.67,.68,.69 D CKPAIR Q:RAOUT
 .. Q:RAOUT
 .. ; if print dosage ticket is Y, then all required flds on ticket s/b Y
 .. S I=.611 F J=.51,.53,.54,.58 D CKPAIR Q:RAOUT
 .. I RAPIECE(.611)="Y" D CKPRNTR^RAUTL19 Q:RAOUT
 .. I $P(^RA(79.2,$P(RANODE(0),U,7),0),U,5)'["Y" D NOTNEED^RAUTL19
 .. Q
 . Q
 Q:RAOUT
 D CKCOMP^RAUTL19B(RAIMG) Q:RAOUT
 D CKREQD^RAUTL19B(RAIMG) Q:RAOUT
 D CKOTHER^RAUTL19A(RAIMG) Q:RAOUT
 ; 'XAMORD^RAMAIN1' hit twice: once for the screen, once for hardcopy
 D XAMORD^RAMAIN1 Q:RAOUT
 I 'RAERR,'RAORDXST D  Q:RAOUT
 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT  D HEAD^RAUTL11
 . W !!?(IOM-$L(RANOERR)\2),RANOERR
 . Q
 S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
 Q
CKPAIR ; when field I is Y, then field J must also be Y at current/lower status
 S RAFLG=0
 ; don't check length of rapiece(j) because we need to treat null as 'no'
 I $L(RAPIECE(I)),(RAYES[RAPIECE(I)),(RANO[RAPIECE(J)) D
 . ; check fields, get field text from Field Title in Data Dictionary
 . S RAFLG=$$ASKPRI^RAUTL19(RAIMG,RAO,J) Q:RAFLG  S RAERR=1 D WRPAIR^RAUTL19
 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT  D HEAD^RAUTL11
 . W !!?5,"Within "_RAIMG_", exam status '"_$P(RANODE(0),"^")_"'"
 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT  D HEAD^RAUTL11
 . W !?5,"order ("_RAO_") '"_$P($G(^DD(72,I,.1)),U)_"' is set to 'Yes'"
 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT  D HEAD^RAUTL11
 . W !?5,"but '"_$P($G(^DD(72,J,.1)),U)_"' is set to 'No'"
 . I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT  D HEAD^RAUTL11
 . W !?5,"in this status and all lower active statuses."
 . Q
 Q
CKWAIT ; CKWAIT is only done for WAITING FOR EXAM and assumes order seq = 1
 F I=.111,.112,.116,.211,.23 S RAPIECE(I)=$P(RANODE($E(I,1,2)),"^",$E(I,3,$L(I)))
 I $Y>(IOSL-6) S RAOUT=$$EOS^RAUTL5() Q:RAOUT  D HEAD^RAUTL11
 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
 Q:RAOUT
 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
 Q:RAOUT
 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
 Q:RAOUT
 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
 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."
 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
 Q