- RARTVER2 ;HISC/FPT-On-line Verify Radiology Reports (cont.) ;11/19/97 13:47
- ;;5.0;Radiology/Nuclear Medicine;**23,26,31**;Mar 16, 1998
- ADDLRPT ; add'l reports to be verified
- S (RARPT,RATOT)=0
- Q:RACHOICE=6
- F S RARPT=$O(^RARPT(RAD,RARADHLD,RARPT)) Q:'RARPT I $D(^RARPT(RARPT,0)) S RARTDT=$S($P(^(0),"^",6)="":9999999.9999,1:$P(^(0),"^",6)) D
- .I $D(^TMP($J,"RA","DT",RARTDT,RARPT)) Q
- .S X=$G(^RARPT(RARPT,0))
- .Q:$$STUB^RAEDCN1(RARPT) ;skip stub report
- .Q:$P(X,"^",5)="V" ; skip if already verified
- .I RACHOICE=1,$P(X,U,12)]"","DR"[$E($P(X,U,5)) D SETTMP Q
- .I RACHOICE=2,$P(X,U,5)="R" D SETTMP Q
- .I RACHOICE=3,$P(X,U,5)="D" D SETTMP Q
- .I RACHOICE=4,$P(X,U,5)="PD" D SETTMP Q
- .I RACHOICE=5 D SETTMP
- I RATOT>0 W $C(7),!!?5,RATOT_" additional exam"_$S(RATOT>1:"s are",1:" is")_" now ready for verification.",!! K DIR S DIR(0)="E",DIR("A")="Press RETURN to Continue" D ^DIR S:$D(DIRUT) RATOT=0 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
- S:RATOT>0 RARLTVFL=""
- Q
- SETTMP ;
- S Y=RARPT D RASET^RAUTL2 Q:'Y ; corrupt record - so ignore!!
- S ^TMP($J,"RA","DT",RARTDT,RARPT)="",RATOT=RATOT+1
- Q
- CU ; clean-up variables
- K %,%DT,%W,%Y1,DA,DGO,DI,DIC,DIWF,DIWR,I,OREND,POP,RA,RACHOICE,RACN,RACNI,RACS,RACT,RAD,RADATE,RADFN,RADIV,RADTE,RADTI,RADUP,RADUZ,RAERR,RAFLG,RAIMGTYI,RAIMGTYJ,RAJ1
- K RANM,RANME,RANUM,RAONLINE,RAOR,RAOUT,RAPGM,RAPRC,RAPRIT,RARAD,RARADHLD,RARDX,RARESFLG,RARPDT,RARLTV,RARLTVFL,RARPT,RARPTX,RARTDT,RARTVER,RARTVERF,RASET,RASIG,RASN,RASTAFF,RASTI,RATOT,RAVER,RAVNB,RAXX,RPTX,X,Y,^TMP($J,"RA")
- K D,D0,D1,DDER,DLAYGO,RACI,X1,ZTSK,DISYS
- Q
- SAVE ; Save key variables. User can first print a report to a slave printer
- ; in which case the key variables are killed by the printing program.
- ; These variables are needed if the user then decides to CONTINUE
- ; editing the STATUS.
- N RAI
- F RAI="RACN","RACNI","RADFN","RADTI","RARPT","RAVER" S RASAVE(RAI)=$G(@RAI)
- Q
- RESTORE ; Restore the variables that were saved above.
- N RAI
- S RAI=""
- F S RAI=$O(RASAVE(RAI)) Q:RAI="" S @RAI=RASAVE(RAI)
- K RASAVE
- Q
- RETURN ; On-line verifier deletes resident pre-verification values. Report
- ; will reappear in the resident's list of choices for the resident
- ; pre-verification option
- N DIR,DIROUT,DIRUT,DTOUT,DUOUT W !
- S DIR("A")="Return to Resident (delete pre-verification)"
- S DIR("?")="If you answer NO, this report will remain pre-verified."
- S DIR("?",1)="If you answer YES, this report will no longer be marked as pre-verifed."
- S DIR("?",2)="It will reappear as a selection in the Resident On-Line Pre-Verification"
- S DIR("?",3)="option for the Resident associated with this report."
- S DIR("?",4)=" "
- S DIR(0)="Y"
- D ^DIR
- Q:Y=0!($D(DIRUT))
- N DA,DIE,DR
- S DIE="^RARPT(",DA=RARPT,DR="14///@;15///@;16///@"
- D ^DIE
- Q
- DISRPT ; Display the report
- S RARTVER="" D RASET Q:'Y D DISP^RART1 K RARTVER
- Q
- PRTRPT ; Print the report
- D SAVE^RARTVER2
- S ION=$P(RAMLC,"^",10),IOP=$S(ION]"":"Q;"_ION,1:"Q")
- S RAMES="W !!,""Report has been queued for printing on device "",ION,"".""" D Q^RARTR
- D RESTORE^RARTVER2
- Q
- RASET ; raset^rautl2 returns radfn,radti,racni's "P"-node
- S Y=RARPT D RASET^RAUTL2 Q:'Y S Y(0)=Y,RANME=$S($D(^DPT(RADFN,0)):$P(^(0),"^"),1:"UNKNOWN"),RAPRC=$S($D(^RAMIS(71,+$P(Y(0),"^",2),0)):$P(^(0),"^"),1:"UNKNOWN")
- Q
- LOCK ; Display the warning message when a user is trying to edit a
- ; locked report
- S RACN=+$P(^RARPT(RARPT,0),"^",4)
- W !!,$C(7),"Another user is editing this report",$S($G(RACN)]"":" (Case # "_RACN_")",1:""),". Please try again later." K DIR S DIR(0)="E" D ^DIR K DIR,DIROUT,DIRUT,DTOUT,DUOUT,RACN G GETRPT^RARTVER
- Q
- EDTCHK ; is user permitted to edit?
- S RASTATUS=+$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",3)
- I $P($G(^RA(72,RASTATUS,0)),"^",3)>0 K RASTATUS Q
- K RASTATUS
- I $D(^XUSEC("RA MGR",DUZ)) Q
- I $P(RAMDV,"^",22)=1 Q
- W $C(7),!!,"The STATUS for this case is CANCELLED. You may not enter a report.",!!
- S RARDX="C" ;user can verify only
- Q
- ERR(RA) ; Display inactive physician message.
- W !!?3,"'"_$P($G(^VA(200,RA,0)),"^")_"' has an inactive provider "
- W "date of "_$$FMTE^XLFDT($P($G(^VA(200,RA,"PS")),"^",4))_".",$C(7)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARTVER2 4188 printed Feb 19, 2025@00:06:01 Page 2
- RARTVER2 ;HISC/FPT-On-line Verify Radiology Reports (cont.) ;11/19/97 13:47
- +1 ;;5.0;Radiology/Nuclear Medicine;**23,26,31**;Mar 16, 1998
- ADDLRPT ; add'l reports to be verified
- +1 SET (RARPT,RATOT)=0
- +2 if RACHOICE=6
- QUIT
- +3 FOR
- SET RARPT=$ORDER(^RARPT(RAD,RARADHLD,RARPT))
- if 'RARPT
- QUIT
- IF $DATA(^RARPT(RARPT,0))
- SET RARTDT=$SELECT($PIECE(^(0),"^",6)="":9999999.9999,1:$PIECE(^(0),"^",6))
- Begin DoDot:1
- +4 IF $DATA(^TMP($JOB,"RA","DT",RARTDT,RARPT))
- QUIT
- +5 SET X=$GET(^RARPT(RARPT,0))
- +6 ;skip stub report
- if $$STUB^RAEDCN1(RARPT)
- QUIT
- +7 ; skip if already verified
- if $PIECE(X,"^",5)="V"
- QUIT
- +8 IF RACHOICE=1
- IF $PIECE(X,U,12)]""
- IF "DR"[$EXTRACT($PIECE(X,U,5))
- DO SETTMP
- QUIT
- +9 IF RACHOICE=2
- IF $PIECE(X,U,5)="R"
- DO SETTMP
- QUIT
- +10 IF RACHOICE=3
- IF $PIECE(X,U,5)="D"
- DO SETTMP
- QUIT
- +11 IF RACHOICE=4
- IF $PIECE(X,U,5)="PD"
- DO SETTMP
- QUIT
- +12 IF RACHOICE=5
- DO SETTMP
- End DoDot:1
- +13 IF RATOT>0
- WRITE $CHAR(7),!!?5,RATOT_" additional exam"_$SELECT(RATOT>1:"s are",1:" is")_" now ready for verification.",!!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to Continue"
- DO ^DIR
- if $DATA(DIRUT)
- SET RATOT=0
- KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
- +14 if RATOT>0
- SET RARLTVFL=""
- +15 QUIT
- SETTMP ;
- +1 ; corrupt record - so ignore!!
- SET Y=RARPT
- DO RASET^RAUTL2
- if 'Y
- QUIT
- +2 SET ^TMP($JOB,"RA","DT",RARTDT,RARPT)=""
- SET RATOT=RATOT+1
- +3 QUIT
- CU ; clean-up variables
- +1 KILL %,%DT,%W,%Y1,DA,DGO,DI,DIC,DIWF,DIWR,I,OREND,POP,RA,RACHOICE,RACN,RACNI,RACS,RACT,RAD,RADATE,RADFN,RADIV,RADTE,RADTI,RADUP,RADUZ,RAERR,RAFLG,RAIMGTYI,RAIMGTYJ,RAJ1
- +2 KILL RANM,RANME,RANUM,RAONLINE,RAOR,RAOUT,RAPGM,RAPRC,RAPRIT,RARAD,RARADHLD,RARDX,RARESFLG,RARPDT,RARLTV,RARLTVFL,RARPT,RARPTX,RARTDT,RARTVER,RARTVERF,RASET,RASIG,RASN,RASTAFF,RASTI,RATOT,RAVER,RAVNB,RAXX,RPTX,X,Y,^TMP($JOB,"RA")
- +3 KILL D,D0,D1,DDER,DLAYGO,RACI,X1,ZTSK,DISYS
- +4 QUIT
- SAVE ; Save key variables. User can first print a report to a slave printer
- +1 ; in which case the key variables are killed by the printing program.
- +2 ; These variables are needed if the user then decides to CONTINUE
- +3 ; editing the STATUS.
- +4 NEW RAI
- +5 FOR RAI="RACN","RACNI","RADFN","RADTI","RARPT","RAVER"
- SET RASAVE(RAI)=$GET(@RAI)
- +6 QUIT
- RESTORE ; Restore the variables that were saved above.
- +1 NEW RAI
- +2 SET RAI=""
- +3 FOR
- SET RAI=$ORDER(RASAVE(RAI))
- if RAI=""
- QUIT
- SET @RAI=RASAVE(RAI)
- +4 KILL RASAVE
- +5 QUIT
- RETURN ; On-line verifier deletes resident pre-verification values. Report
- +1 ; will reappear in the resident's list of choices for the resident
- +2 ; pre-verification option
- +3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
- WRITE !
- +4 SET DIR("A")="Return to Resident (delete pre-verification)"
- +5 SET DIR("?")="If you answer NO, this report will remain pre-verified."
- +6 SET DIR("?",1)="If you answer YES, this report will no longer be marked as pre-verifed."
- +7 SET DIR("?",2)="It will reappear as a selection in the Resident On-Line Pre-Verification"
- +8 SET DIR("?",3)="option for the Resident associated with this report."
- +9 SET DIR("?",4)=" "
- +10 SET DIR(0)="Y"
- +11 DO ^DIR
- +12 if Y=0!($DATA(DIRUT))
- QUIT
- +13 NEW DA,DIE,DR
- +14 SET DIE="^RARPT("
- SET DA=RARPT
- SET DR="14///@;15///@;16///@"
- +15 DO ^DIE
- +16 QUIT
- DISRPT ; Display the report
- +1 SET RARTVER=""
- DO RASET
- if 'Y
- QUIT
- DO DISP^RART1
- KILL RARTVER
- +2 QUIT
- PRTRPT ; Print the report
- +1 DO SAVE^RARTVER2
- +2 SET ION=$PIECE(RAMLC,"^",10)
- SET IOP=$SELECT(ION]"":"Q;"_ION,1:"Q")
- +3 SET RAMES="W !!,""Report has been queued for printing on device "",ION,""."""
- DO Q^RARTR
- +4 DO RESTORE^RARTVER2
- +5 QUIT
- RASET ; raset^rautl2 returns radfn,radti,racni's "P"-node
- +1 SET Y=RARPT
- DO RASET^RAUTL2
- if 'Y
- QUIT
- SET Y(0)=Y
- SET RANME=$SELECT($DATA(^DPT(RADFN,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- SET RAPRC=$SELECT($DATA(^RAMIS(71,+$PIECE(Y(0),"^",2),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- +2 QUIT
- LOCK ; Display the warning message when a user is trying to edit a
- +1 ; locked report
- +2 SET RACN=+$PIECE(^RARPT(RARPT,0),"^",4)
- +3 WRITE !!,$CHAR(7),"Another user is editing this report",$SELECT($GET(RACN)]"":" (Case # "_RACN_")",1:""),". Please try again later."
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,RACN
- GOTO GETRPT^RARTVER
- +4 QUIT
- EDTCHK ; is user permitted to edit?
- +1 SET RASTATUS=+$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",3)
- +2 IF $PIECE($GET(^RA(72,RASTATUS,0)),"^",3)>0
- KILL RASTATUS
- QUIT
- +3 KILL RASTATUS
- +4 IF $DATA(^XUSEC("RA MGR",DUZ))
- QUIT
- +5 IF $PIECE(RAMDV,"^",22)=1
- QUIT
- +6 WRITE $CHAR(7),!!,"The STATUS for this case is CANCELLED. You may not enter a report.",!!
- +7 ;user can verify only
- SET RARDX="C"
- +8 QUIT
- ERR(RA) ; Display inactive physician message.
- +1 WRITE !!?3,"'"_$PIECE($GET(^VA(200,RA,0)),"^")_"' has an inactive provider "
- +2 WRITE "date of "_$$FMTE^XLFDT($PIECE($GET(^VA(200,RA,"PS")),"^",4))_".",$CHAR(7)
- +3 QUIT