- 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
- 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
