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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAUTL19C 5009 printed Nov 22, 2024@17:50:19 Page 2
RAUTL19C ;HISC/GJC-Utility Routine ;10/29/97 12:42
+1 ;;5.0;Radiology/Nuclear Medicine;**10**;Mar 16, 1998
+2 ;
EN1 ; Check data consistency
+1 NEW I,J,RAERR,RAFLG,RAIEN,RANO,RANODE,RAO,RAPIECE,RAYES,RAWATERR,RACHKERR
+2 SET RAERR=0
SET RANO="Nn"
SET RAYES="Yy"
SET RACHKERR=0
SET RAWATERR=0
DO HEAD^RAUTL11
+3 SET RAO=""
FOR
SET RAO=$ORDER(^RA(72,"AA",RAIMG,RAO))
if RAO']""
QUIT
Begin DoDot:1
+4 SET RAIEN=0
+5 FOR
SET RAIEN=+$ORDER(^RA(72,"AA",RAIMG,RAO,RAIEN))
if 'RAIEN
QUIT
Begin DoDot:2
+6 SET RANODE(0)=$GET(^RA(72,RAIEN,0))
SET RANODE(.1)=$GET(^(.1))
SET RANODE(.2)=$GET(^(.2))
SET RANODE(.5)=$GET(^(.5))
SET RANODE(.6)=$GET(^(.6))
+7 ; let rapiece(.25)=$p(ranode(.2),"^",5), etc
+8 KILL RAPIECE
+9 FOR 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
SET RAPIECE(I)=$PIECE(RANODE($EXTRACT(I,1,2)),"^",$EXTRACT(I,3,$LENGTH(I)))
+10 IF $PIECE(RANODE(0),U,3)=1
DO CKWAIT
if RAOUT
QUIT
+11 ; if REQUIRED fld=Y, its corresp ASK fld must be Y at same/lower status
+12 ; field .11<->field .21, .12<->.22, .14<->.24, .15<->.25, .16<->.26
+13 ; .51<->.61, .53<->.63, .54<->.64
+14 ; .55<->.65, .58<->.68, .59<->.69
+15 FOR I=.11,.12,.14,.15,.16,.51,.53,.54,.55,.58,.59,.113,.114
SET J=I+.1
DO CKPAIR
if RAOUT
QUIT
+16 if RAOUT
QUIT
+17 ; ASK PHARM ADM DT/TIME/PERSON must be Y before ASK PHARM & DOSAGE=Y
+18 SET I=.28
SET J=.27
DO CKPAIR
+19 if RAOUT
QUIT
+20 ; if IMPRESSION is required, then REPORT should also be required
+21 IF $$UP^XLFSTR(RAPIECE(.116))="Y"
IF $$UP^XLFSTR(RAPIECE(.111))'="Y"
Begin DoDot:3
+22 WRITE !!?5,"<WARNING> -- Within "_RAIMG_", exam status '"_$PIECE(RANODE(0),"^")_"'"
+23 WRITE !?5,"Impression is required, but a report is not, so an exam"
+24 WRITE !?5,"will be able to reach this status without a report.",!?5
+25 WRITE "But if a report is entered, an impression will be required.",!
+26 QUIT
End DoDot:3
+27 ; other Radiopharm flds must be Y before ASK RADIOPHARM & DOSAGES=Y
+28 SET J=.61
FOR I=.53,.54,.57,.58,.59,.63,.64,.65,.67,.68,.69
DO CKPAIR
if RAOUT
QUIT
+29 if RAOUT
QUIT
+30 ; if print dosage ticket is Y, then all required flds on ticket s/b Y
+31 SET I=.611
FOR J=.51,.53,.54,.58
DO CKPAIR
if RAOUT
QUIT
+32 IF RAPIECE(.611)="Y"
DO CKPRNTR^RAUTL19
if RAOUT
QUIT
+33 IF $PIECE(^RA(79.2,$PIECE(RANODE(0),U,7),0),U,5)'["Y"
DO NOTNEED^RAUTL19
+34 QUIT
End DoDot:2
if RAOUT
QUIT
+35 QUIT
End DoDot:1
if RAOUT
QUIT
+36 if RAOUT
QUIT
+37 DO CKCOMP^RAUTL19B(RAIMG)
if RAOUT
QUIT
+38 DO CKREQD^RAUTL19B(RAIMG)
if RAOUT
QUIT
+39 DO CKOTHER^RAUTL19A(RAIMG)
if RAOUT
QUIT
+40 ; 'XAMORD^RAMAIN1' hit twice: once for the screen, once for hardcopy
+41 DO XAMORD^RAMAIN1
if RAOUT
QUIT
+42 IF 'RAERR
IF 'RAORDXST
Begin DoDot:1
+43 IF $Y>(IOSL-6)
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
DO HEAD^RAUTL11
+44 WRITE !!?(IOM-$LENGTH(RANOERR)\2),RANOERR
+45 QUIT
End DoDot:1
if RAOUT
QUIT
+46 if $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZISC
+47 QUIT
CKPAIR ; when field I is Y, then field J must also be Y at current/lower status
+1 SET RAFLG=0
+2 ; don't check length of rapiece(j) because we need to treat null as 'no'
+3 IF $LENGTH(RAPIECE(I))
IF (RAYES[RAPIECE(I))
IF (RANO[RAPIECE(J))
Begin DoDot:1
+4 ; check fields, get field text from Field Title in Data Dictionary
+5 SET RAFLG=$$ASKPRI^RAUTL19(RAIMG,RAO,J)
if RAFLG
QUIT
SET RAERR=1
DO WRPAIR^RAUTL19
+6 IF $Y>(IOSL-6)
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
DO HEAD^RAUTL11
+7 WRITE !!?5,"Within "_RAIMG_", exam status '"_$PIECE(RANODE(0),"^")_"'"
+8 IF $Y>(IOSL-6)
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
DO HEAD^RAUTL11
+9 WRITE !?5,"order ("_RAO_") '"_$PIECE($GET(^DD(72,I,.1)),U)_"' is set to 'Yes'"
+10 IF $Y>(IOSL-6)
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
DO HEAD^RAUTL11
+11 WRITE !?5,"but '"_$PIECE($GET(^DD(72,J,.1)),U)_"' is set to 'No'"
+12 IF $Y>(IOSL-6)
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
DO HEAD^RAUTL11
+13 WRITE !?5,"in this status and all lower active statuses."
+14 QUIT
End DoDot:1
+15 QUIT
CKWAIT ; CKWAIT is only done for WAITING FOR EXAM and assumes order seq = 1
+1 FOR I=.111,.112,.116,.211,.23
SET RAPIECE(I)=$PIECE(RANODE($EXTRACT(I,1,2)),"^",$EXTRACT(I,3,$LENGTH(I)))
+2 IF $Y>(IOSL-6)
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
DO HEAD^RAUTL11
+3 SET I=.2
FOR
SET I=$ORDER(RAPIECE(I))
if I>.29
QUIT
if I=""
QUIT
SET J=$$UP^XLFSTR(RAPIECE(I))
IF J="Y"
DO WRWAIT^RAUTL19
WRITE !?5,"'",$PIECE($GET(^DD(72,I,.1)),U),"'"
SET RAERR=1
IF $Y>(IOSL-6)
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
DO HEAD^RAUTL11
+4 if RAOUT
QUIT
+5 SET I=.6
FOR
SET I=$ORDER(RAPIECE(I))
if I>.69
QUIT
if I=""
QUIT
SET J=$$UP^XLFSTR(RAPIECE(I))
IF J="Y"
DO WRWAIT^RAUTL19
WRITE !?5,"'",$PIECE($GET(^DD(72,I,.1)),U),"'"
SET RAERR=1
IF $Y>(IOSL-6)
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
DO HEAD^RAUTL11
+6 if RAOUT
QUIT
+7 SET I=.1
FOR
SET I=$ORDER(RAPIECE(I))
if I>.19
QUIT
if I=""
QUIT
SET J=$$UP^XLFSTR(RAPIECE(I))
IF J="Y"
DO WRWAIT^RAUTL19
WRITE !?5,"'",$PIECE($GET(^DD(72,I,.1)),U),"'"
SET RAERR=1
IF $Y>(IOSL-6)
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
DO HEAD^RAUTL11
+8 if RAOUT
QUIT
+9 SET I=.5
FOR
SET I=$ORDER(RAPIECE(I))
if I>.59
QUIT
if I=""
QUIT
SET J=$$UP^XLFSTR(RAPIECE(I))
IF J="Y"
DO WRWAIT^RAUTL19
WRITE !?5,"'",$PIECE($GET(^DD(72,I,.1)),U),"'"
SET RAERR=1
IF $Y>(IOSL-6)
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
DO HEAD^RAUTL11
+10 if RAERR
WRITE !!?5,"The above fields need not be answered for the ",$PIECE(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."
+11 IF $$UP^XLFSTR(RAPIECE(.611))="Y"
DO WRWAIT^RAUTL19
WRITE !!?5,"'",$PIECE($GET(^DD(72,.611,.1)),U),"' should NOT be Y",!,?5,"for status of ",$PIECE(RANODE(0),U)
SET RAERR=1
IF $Y>(IOSL-6)
SET RAOUT=$$EOS^RAUTL5()
if RAOUT
QUIT
DO HEAD^RAUTL11
+12 QUIT
