- RARTUVR2 ;HISC/FPT,SWM -Unverified Reports ;11/26/97 07:57
- ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- PRINT ; print entries
- S RACNT(0)=RACNT(0)+1
- D HDR
- I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT=1
- I ^TMP($J,"RAUVR",RADIVNME,RAITNAME)=0 D NEGRPT D Q
- . I RACNT(0)<RACNT S RAOUT=$$EOS^RAUTL5()
- . Q
- F RARS="S","R","U" Q:RAOUT!(RAOUT) D
- . I ($Y+4)>IOSL S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HDR
- . S RASTRING=$S(RARS="S":"STAFF^STFCNT",RARS="R":"RESIDENT^RESCNT",1:"UNKNOWN^UNKCNT")
- . D:RABD="B" HOURAGE
- . W !,"* ",$P(RASTRING,U),": ",^TMP($J,RADIVNME,RAITNAME,$P(RASTRING,U,2))," *"
- . S RAFL=0,RAIPNAME=""
- . F S RAIPNAME=$O(^TMP($J,RADIVNME,RAITNAME,RARS,RAIPNAME)) Q:RAIPNAME="" D Q:RAOUT
- .. I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT=1
- .. D PRTB
- .. Q:RAOUT D:RABD="D" PRTD
- .. Q
- . W !!
- . Q
- W !
- Q:RAOUT I RACNT(0)<RACNT S RAOUT=$$EOS^RAUTL5()
- Q
- HDR ; header
- W:$Y>0 @IOF W !?$S(IOM<81:20,1:IOM-90),">>>>> Unverified Reports ("_$S(RABD="B":"brief",1:"detailed")_") <<<<<" S RAPAGE=RAPAGE+1 W ?$S(IOM<81:70,1:IOM-10),"Page: ",RAPAGE
- W !,"Division: ",?10,RADIVNME,?$S(IOM<81:43,1:IOM-37),"Report Date Range:",?$S(IOM<81:62,1:IOM-18),$$FMTE^XLFDT(BEGDATE)
- W !,"Imaging Type: ",RAITNAME,?$S(IOM<81:62,1:IOM-18),$$FMTE^XLFDT(ENDDATE),!,"Run Date: ",RARUNDAT,?$S(IOM<81:45,1:IOM-35),"Total Unverified Reports: ",^TMP($J,"RAUVR",RADIVNME,RAITNAME),!
- Q
- ;
- NEGRPT ; negative reports
- W !!?$S(IOM<81:26,1:IOM-84),"***************************"
- W !?$S(IOM<81:26,1:IOM-84),"* No Unverified Reports *"
- W !?$S(IOM<81:26,1:IOM-84),"***************************",!
- Q
- PRTB I ($Y+4)>IOSL S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HDR
- I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT=1
- W:RABD="D" !,RAEQUAL
- D:RABD="D" HOURAGE
- S RA1=50+$L(RACUT(3))+21
- W !,$J(^TMP($J,RADIVNME,RAITNAME,RARS,RAIPNAME),3)," "
- W $E(RAIPNAME,1,20)
- W ?29,$S($G(^TMP($J,RADIVNME,RAITNAME,RARS,RAIPNAME,"H",1)):$J(^(1),$L(RACUT(3))),1:$J(0,$L(RACUT(3)))),?39,$S($G(^(2)):$J(^(2),$L(RACUT(3))),1:$J(0,$L(RACUT(3))))
- W ?49,$S($G(^(3)):$J(^(3),$L(RACUT(3))),1:$J(0,$L(RACUT(3)))),?59,$S($G(^(4)):$J(^(4),$L(RACUT(3))+2),1:$J(0,$L(RACUT(3))+2))
- Q
- PRTD K ^TMP($J,"RA0") N RA1,RA2,RA3,RA4,RARPT,RADFN,RADTI,RACNI
- Q:'+$O(^TMP($J,RADIVNME,RAITNAME,RARS,RAIPNAME,0))
- S RARPT=0
- F S RARPT=$O(^TMP($J,RADIVNME,RAITNAME,RARS,RAIPNAME,RARPT)) Q:'+RARPT S X=^(RARPT) D Q:RAOUT
- . I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAOUT=1 Q:RAOUT=1
- . S RADFN=$P(X,U),RADTI=$P(X,U,2),RACNI=$P(X,U,3)
- . S RA1=$G(^RARPT(RARPT,0)),RA2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- . S RA3=$P(RA1,U,6) ;date report entered
- . S DFN=RADFN D DEM^VADPT
- . S ^TMP($J,"RA0",RA3)=$E(VADM(1))_$$SSN^RAUTL_U_$P(RA1,U,5) ;pc1=1st initial of last name_ssn, pc2=report status
- . K VADM S X=$P(RA1,U,12) D SETX,APPEND ;pc3=pre-verif dt
- . S X=$$FMTE^XLFDT($P(RA1,U,3)),X=$E($P(X,"@",2),1,5),X=$S(X]"":"@"_X,1:"")
- . S X=$P(RA1,U)_X D APPEND ;pc4=day/case_exam hrmin
- . S X=$P(RA2,U,11) S X=$S(+X:$P($G(^RAO(75.1,X,0)),U,21),1:"") D SETX,APPEND ; pc5=date desired from file 75.1
- . S X=$P(RA2,U,2) D APPEND ;pc6=procedure pointer
- . Q
- S RA3=0 F S RA3=$O(^TMP($J,"RA0",RA3)) Q:RA3="" D Q:RAOUT W !
- . I ($Y+4)>IOSL S RAOUT=$$EOS^RAUTL5() Q:RAOUT D HDR
- . S X=RA3 D SETX
- . W !,"Transcrip: ",X,?27,"ID: ",$P(^TMP($J,"RA0",RA3),U),?47
- . S X=$P(^(RA3),U,2) W $S(X="D":"DRAFT",X="PD":"PROB/DRAFT",X="R":"RELEASE",X="V":"VERIFIED",1:"")
- . W ?58,"Pre-ver: ",$P(^(RA3),U,3)
- . W !,"Exam Date: ",$P(^TMP($J,"RA0",RA3),U,4),?31,"Order Date Desired: ",$P(^(RA3),U,5)
- . I +$P(^(RA3),U,6) W:IOM<81 ! W ?$S(IOM<81:0,1:IOM-66),"Proc: ",$E($P($G(^RAMIS(71,$P(^(RA3),U,6),0)),U),1,60)
- . S Y(0)=RA2 D PHYS^RARTUVR1
- . Q
- Q
- SETX I $L(X)=0 S X="" Q
- S RA4=$E($P($$FMTE^XLFDT(X),"@",2),1,5),RA4=$S(RA4]"":"@"_RA4,1:"")
- S X=$E(X,4,5)_$E(X,6,7)_$E(X,2,3)
- S X=X_RA4
- Q
- APPEND S ^(RA3)=^TMP($J,"RA0",RA3)_U_X Q
- HOURAGE W !,"Hours (age of report)",?29,$J(RACUT(1),$L(RACUT(3))),?39,$J(RACUT(2),$L(RACUT(3))),?49,$J(RACUT(3),$L(RACUT(3))),?59,">",$J(RACUT(3),$L(RACUT(3))+1)
- W !?29,$E(RADASH,1,$L(RACUT(3))),?39,$E(RADASH,1,$L(RACUT(3))),?49,$E(RADASH,1,$L(RACUT(3))),?59,$E(RADASH,1,$L(RACUT(3))+2)
- Q
- RARTUVR2 ;HISC/FPT,SWM -Unverified Reports ;11/26/97 07:57
- +1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- PRINT ; print entries
- +1 SET RACNT(0)=RACNT(0)+1
- +2 DO HDR
- +3 IF $DATA(ZTQUEUED)
- DO STOPCHK^RAUTL9
- IF $GET(ZTSTOP)=1
- SET RAOUT=1
- IF RAOUT=1
- QUIT
- +4 IF ^TMP($JOB,"RAUVR",RADIVNME,RAITNAME)=0
- DO NEGRPT
- Begin DoDot:1
- +5 IF RACNT(0)<RACNT
- SET RAOUT=$$EOS^RAUTL5()
- +6 QUIT
- End DoDot:1
- QUIT
- +7 FOR RARS="S","R","U"
- IF RAOUT!(RAOUT)
- QUIT
- Begin DoDot:1
- +8 IF ($Y+4)>IOSL
- SET RAOUT=$$EOS^RAUTL5()
- IF RAOUT
- QUIT
- DO HDR
- +9 SET RASTRING=$SELECT(RARS="S":"STAFF^STFCNT",RARS="R":"RESIDENT^RESCNT",1:"UNKNOWN^UNKCNT")
- +10 IF RABD="B"
- DO HOURAGE
- +11 WRITE !,"* ",$PIECE(RASTRING,U),": ",^TMP($JOB,RADIVNME,RAITNAME,$PIECE(RASTRING,U,2))," *"
- +12 SET RAFL=0
- SET RAIPNAME=""
- +13 FOR
- SET RAIPNAME=$ORDER(^TMP($JOB,RADIVNME,RAITNAME,RARS,RAIPNAME))
- IF RAIPNAME=""
- QUIT
- Begin DoDot:2
- +14 IF $DATA(ZTQUEUED)
- DO STOPCHK^RAUTL9
- IF $GET(ZTSTOP)=1
- SET RAOUT=1
- IF RAOUT=1
- QUIT
- +15 DO PRTB
- +16 IF RAOUT
- QUIT
- IF RABD="D"
- DO PRTD
- +17 QUIT
- End DoDot:2
- IF RAOUT
- QUIT
- +18 WRITE !!
- +19 QUIT
- End DoDot:1
- +20 WRITE !
- +21 IF RAOUT
- QUIT
- IF RACNT(0)<RACNT
- SET RAOUT=$$EOS^RAUTL5()
- +22 QUIT
- HDR ; header
- +1 IF $Y>0
- WRITE @IOF
- WRITE !?$SELECT(IOM<81:20,1:IOM-90),">>>>> Unverified Reports ("_$SELECT(RABD="B":"brief",1:"detailed")_") <<<<<"
- SET RAPAGE=RAPAGE+1
- WRITE ?$SELECT(IOM<81:70,1:IOM-10),"Page: ",RAPAGE
- +2 WRITE !,"Division: ",?10,RADIVNME,?$SELECT(IOM<81:43,1:IOM-37),"Report Date Range:",?$SELECT(IOM<81:62,1:IOM-18),$$FMTE^XLFDT(BEGDATE)
- +3 WRITE !,"Imaging Type: ",RAITNAME,?$SELECT(IOM<81:62,1:IOM-18),$$FMTE^XLFDT(ENDDATE),!,"Run Date: ",RARUNDAT,?$SELECT(IOM<81:45,1:IOM-35),"Total Unverified Reports: ",^TMP($JOB,"RAUVR",RADIVNME,RAITNAME),!
- +4 QUIT
- +5 ;
- NEGRPT ; negative reports
- +1 WRITE !!?$SELECT(IOM<81:26,1:IOM-84),"***************************"
- +2 WRITE !?$SELECT(IOM<81:26,1:IOM-84),"* No Unverified Reports *"
- +3 WRITE !?$SELECT(IOM<81:26,1:IOM-84),"***************************",!
- +4 QUIT
- PRTB IF ($Y+4)>IOSL
- SET RAOUT=$$EOS^RAUTL5()
- IF RAOUT
- QUIT
- DO HDR
- +1 IF $DATA(ZTQUEUED)
- DO STOPCHK^RAUTL9
- IF $GET(ZTSTOP)=1
- SET RAOUT=1
- IF RAOUT=1
- QUIT
- +2 IF RABD="D"
- WRITE !,RAEQUAL
- +3 IF RABD="D"
- DO HOURAGE
- +4 SET RA1=50+$LENGTH(RACUT(3))+21
- +5 WRITE !,$JUSTIFY(^TMP($JOB,RADIVNME,RAITNAME,RARS,RAIPNAME),3)," "
- +6 WRITE $EXTRACT(RAIPNAME,1,20)
- +7 WRITE ?29,$SELECT($GET(^TMP($JOB,RADIVNME,RAITNAME,RARS,RAIPNAME,"H",1)):$JUSTIFY(^(1),$LENGTH(RACUT(3))),1:$JUSTIFY(0,$LENGTH(RACUT(3)))),?39,$SELECT($GET(^(2)):$JUSTIFY(^(2),$LENGTH(RACUT(3))),1:$JUSTIFY(0,$LENGTH(RACUT(3))))
- +8 WRITE ?49,$SELECT($GET(^(3)):$JUSTIFY(^(3),$LENGTH(RACUT(3))),1:$JUSTIFY(0,$LENGTH(RACUT(3)))),?59,$SELECT($GET(^(4)):$JUSTIFY(^(4),$LENGTH(RACUT(3))+2),1:$JUSTIFY(0,$LENGTH(RACUT(3))+2))
- +9 QUIT
- PRTD KILL ^TMP($JOB,"RA0")
- NEW RA1,RA2,RA3,RA4,RARPT,RADFN,RADTI,RACNI
- +1 IF '+$ORDER(^TMP($JOB,RADIVNME,RAITNAME,RARS,RAIPNAME,0))
- QUIT
- +2 SET RARPT=0
- +3 FOR
- SET RARPT=$ORDER(^TMP($JOB,RADIVNME,RAITNAME,RARS,RAIPNAME,RARPT))
- IF '+RARPT
- QUIT
- SET X=^(RARPT)
- Begin DoDot:1
- +4 IF $DATA(ZTQUEUED)
- DO STOPCHK^RAUTL9
- IF $GET(ZTSTOP)=1
- SET RAOUT=1
- IF RAOUT=1
- QUIT
- +5 SET RADFN=$PIECE(X,U)
- SET RADTI=$PIECE(X,U,2)
- SET RACNI=$PIECE(X,U,3)
- +6 SET RA1=$GET(^RARPT(RARPT,0))
- SET RA2=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- +7 ;date report entered
- SET RA3=$PIECE(RA1,U,6)
- +8 SET DFN=RADFN
- DO DEM^VADPT
- +9 ;pc1=1st initial of last name_ssn, pc2=report status
- SET ^TMP($JOB,"RA0",RA3)=$EXTRACT(VADM(1))_$$SSN^RAUTL_U_$P(RA1,U,5)
- +10 ;pc3=pre-verif dt
- KILL VADM
- SET X=$PIECE(RA1,U,12)
- DO SETX
- DO APPEND
- +11 SET X=$$FMTE^XLFDT($PIECE(RA1,U,3))
- SET X=$EXTRACT($PIECE(X,"@",2),1,5)
- SET X=$SELECT(X]"":"@"_X,1:"")
- +12 ;pc4=day/case_exam hrmin
- SET X=$PIECE(RA1,U)_X
- DO APPEND
- +13 ; pc5=date desired from file 75.1
- SET X=$PIECE(RA2,U,11)
- SET X=$SELECT(+X:$PIECE($GET(^RAO(75.1,X,0)),U,21),1:"")
- DO SETX
- DO APPEND
- +14 ;pc6=procedure pointer
- SET X=$PIECE(RA2,U,2)
- DO APPEND
- +15 QUIT
- End DoDot:1
- IF RAOUT
- QUIT
- +16 SET RA3=0
- FOR
- SET RA3=$ORDER(^TMP($JOB,"RA0",RA3))
- IF RA3=""
- QUIT
- Begin DoDot:1
- +17 IF ($Y+4)>IOSL
- SET RAOUT=$$EOS^RAUTL5()
- IF RAOUT
- QUIT
- DO HDR
- +18 SET X=RA3
- DO SETX
- +19 WRITE !,"Transcrip: ",X,?27,"ID: ",$PIECE(^TMP($JOB,"RA0",RA3),U),?47
- +20 SET X=$PIECE(^(RA3),U,2)
- WRITE $SELECT(X="D":"DRAFT",X="PD":"PROB/DRAFT",X="R":"RELEASE",X="V":"VERIFIED",1:"")
- +21 WRITE ?58,"Pre-ver: ",$PIECE(^(RA3),U,3)
- +22 WRITE !,"Exam Date: ",$PIECE(^TMP($JOB,"RA0",RA3),U,4),?31,"Order Date Desired: ",$PIECE(^(RA3),U,5)
- +23 IF +$PIECE(^(RA3),U,6)
- IF IOM<81
- WRITE !
- WRITE ?$SELECT(IOM<81:0,1:IOM-66),"Proc: ",$EXTRACT($PIECE($GET(^RAMIS(71,$PIECE(^(RA3),U,6),0)),U),1,60)
- +24 SET Y(0)=RA2
- DO PHYS^RARTUVR1
- +25 QUIT
- End DoDot:1
- IF RAOUT
- QUIT
- WRITE !
- +26 QUIT
- SETX IF $LENGTH(X)=0
- SET X=""
- QUIT
- +1 SET RA4=$EXTRACT($PIECE($$FMTE^XLFDT(X),"@",2),1,5)
- SET RA4=$SELECT(RA4]"":"@"_RA4,1:"")
- +2 SET X=$EXTRACT(X,4,5)_$EXTRACT(X,6,7)_$EXTRACT(X,2,3)
- +3 SET X=X_RA4
- +4 QUIT
- APPEND SET ^(RA3)=^TMP($JOB,"RA0",RA3)_U_X
- QUIT
- HOURAGE WRITE !,"Hours (age of report)",?29,$JUSTIFY(RACUT(1),$LENGTH(RACUT(3))),?39,$JUSTIFY(RACUT(2),$LENGTH(RACUT(3))),?49,$JUSTIFY(RACUT(3),$LENGTH(RACUT(3))),?59,">",$JUSTIFY(RACUT(3),$LENGTH(RACUT(3))+1)
- +1 WRITE !?29,$EXTRACT(RADASH,1,$LENGTH(RACUT(3))),?39,$EXTRACT(RADASH,1,$LENGTH(RACUT(3))),?49,$EXTRACT(RADASH,1,$LENGTH(RACUT(3))),?59,$EXTRACT(RADASH,1,$LENGTH(RACUT(3))+2)
- +2 QUIT
