- RAORDC ;HISC/CAH,FPT,GJC,DAD AISC/RMO-Check Request Status against Exam Status ;4/9/97 12:06
- ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- ;
- ;The variables RADFN, RADTI and RACNI must be defined. The variable
- ;RADELFLG is set when the exam is being deleted. This routine is
- ;called after an exam status is updated, to update the order status.
- ;Called from RAEDCN after exam cancel or delete, from RAESO after
- ;override single exam to complete, from RASTED after exam status is
- ;updated successfully, and from RAUTL1 after exam status update.
- G Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S RAEXM0=^(0),RAEXOR=$S($D(RADELFLG):0,$D(^RA(72,+$P(RAEXM0,"^",3),0)):$P(^(0),"^",3),1:""),RAOIFN=+$P(RAEXM0,"^",11) G Q:'$D(^RAO(75.1,RAOIFN,0)) S (RAORD0,RAORDB4)=^(0)
- S RAOSTS=$S(RAEXOR=0:0,RAEXOR>0&(RAEXOR<9):6,RAEXOR=9:2,1:"") D EXMCAN:RAOSTS=0,EXMCOM:RAOSTS=2,^RAORDU:RAOSTS=6&(RAOSTS'=$P(RAORD0,"^",5))
- I $D(RASN),(RASN="EXAMINED") D ^RAORDU:RAOSTS=6 ;IHS/ITSC/CLS 12/31/2003 sends an HL7 message at examined
- I $P($G(RAORDB4),"^",5)=2,(RAOSTS'=2) D
- . ; Prior request status complete ($P(RAORDB4,"^",5)=2), new request
- . ; status (RAOSTS) not complete & OE/RR version not less than 3 issue
- . ; roll back message
- . D:$$ORVR^RAORDU()'<3 EN2^RAO7CH(RAOIFN)
- . ; Delete 'V' file pointers if PCE installed & outpatient
- . I $P(RAEXM0,"^",6)]"",($P(^DIC(42,$P(RAEXM0,"^",6),0),"^",3)'="D") Q
- . D:$$PCE^RAWORK() UNCOMPL^RAPCE1(RADFN,RADTI,RACNI)
- . Q
- Q K RABLNK,RACAT,RAEXM0,RAEXOR,RAILP,RAMIFN,RAMOD,RAMODA,RAMODD,RAOIFN,RAORD0,RAORDB4,RAOSTS,RAPRC,RARSH,RASHA,X
- I '$D(N)!($D(RAOREA)<10) K RAOREA Q
- I $D(RAOREA)>1,$G(N) K RAOREA(N) I $D(RAOREA)<10 K RAOREA
- Q
- ;
- EXMCAN ; Update request status to cancel or hold.
- N RAXIT S RAXIT=0
- S RAOREA=$S($D(RAOREA):RAOREA,1:$O(^RA(75.2,"B",$S($D(RADELFLG):"EXAM DELETED",1:"EXAM CANCELLED"),0)))
- ;
- ASKCAN S RA=$O(^RADPT("AO",RAOIFN,RADFN,RADTI,0))
- I RA,$O(^RADPT("AO",RAOIFN,RADFN,RADTI,RA)) D Q:RAXIT
- . ; If # descendents > 1 do not allow order to be deleted or canceled
- . N RAESTAT S RAESTAT=$$EN1^RASETU(RAOIFN,RADFN)
- . Q:+$P(RAESTAT,"^",3) ; all other exams have been cancelled
- . S RAXIT=1 ; if ramaining xams complete -or- at least one of the other
- . ; xams not cancelled, take appropriate action, quit EXMCAN
- . I +RAESTAT=9 S RAOSTS=2 D ^RAORDU S RAOSTS=0 Q ; all xams complete
- . W !!?5,"Please note, however, that more than one procedure is associated"
- . W !?5,"with the procedure's Parent request. The Parent request will not"
- . W !?5,"be canceled or put or hold unless all the registered descendent"
- . W !?5,"procedures are canceled or deleted.",!,$C(7)
- . Q
- W !!,"Do you want to cancel the request associated with this exam" S %=2 D YN^DICN S RAOSTS=$S(%=1:1,%=2:3,1:0) I 'RAOSTS W !!,"Required, enter 'YES' if the request should be cancelled or 'NO' to put",!,"it on hold." G ASKCAN
- I RAOSTS=1,$D(RADELFLG) D
- . ; Remove EXAM SET flag if parent order deleted
- . N DA,DIE,DR
- . S DIE="^RADPT("_RADFN_",""DT"",",DA(1)=RADFN,DA=RADTI,DR="5///@"
- . D ^DIE
- . Q
- I RAOSTS=3 S (DIE,DIC)="^RAO(75.1,",DIC(0)="AEQM",DA=RAOIFN,DR="25" W ! D ^DIE K DIE,DIC,DA,DR
- D ^RAORDU W !?10,"...request status updated to ",$S(RAOSTS=1:"discontinued",1:"hold"),"."
- Q
- ;
- EXMCOM ; Code moved to EXMCOM^RAORDC1 to save on space. To update request
- ; statuses for complete exams.
- D EXMCOM^RAORDC1 Q
- ;
- DELMOD S DA(1)=RAOIFN,DA=RAMIFN,DIK="^RAO(75.1,"_DA(1)_",""M""," D ^DIK K DA,DIK S RAMODD=""
- Q
- ;
- ADDMOD S X=$S($D(^RAMIS(71.2,RAILP,0)):$P(^(0),"^"),1:"") I X'="" S:'$D(^RAO(75.1,RAOIFN,"M",0)) ^(0)="^75.1125PA^^" S DIC(0)="L",DLAYGO=75.1,DA(1)=RAOIFN,DIC="^RAO(75.1,RAOIFN,""M""," D ^DIC K DA,DIC S RAMODA=""
- Q
- RAORDC ;HISC/CAH,FPT,GJC,DAD AISC/RMO-Check Request Status against Exam Status ;4/9/97 12:06
- +1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- +2 ;
- +3 ;The variables RADFN, RADTI and RACNI must be defined. The variable
- +4 ;RADELFLG is set when the exam is being deleted. This routine is
- +5 ;called after an exam status is updated, to update the order status.
- +6 ;Called from RAEDCN after exam cancel or delete, from RAESO after
- +7 ;override single exam to complete, from RASTED after exam status is
- +8 ;updated successfully, and from RAUTL1 after exam status update.
- +9 IF '$DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- GOTO Q
- SET RAEXM0=^(0)
- SET RAEXOR=$SELECT($DATA(RADELFLG):0,$DATA(^RA(72,+$PIECE(RAEXM0,"^",3),0)):$PIECE(^(0),"^",3),1:"")
- SET RAOIFN=+$PIECE(RAEXM0,"^",11)
- IF '$DATA(^RAO(75.1,RAOIFN,0))
- GOTO Q
- SET (RAORD0,RAORDB4)=^(0)
- +10 SET RAOSTS=$SELECT(RAEXOR=0:0,RAEXOR>0&(RAEXOR<9):6,RAEXOR=9:2,1:"")
- IF RAOSTS=0
- DO EXMCAN
- IF RAOSTS=2
- DO EXMCOM
- IF RAOSTS=6&(RAOSTS'=$PIECE(RAORD0,"^",5))
- DO ^RAORDU
- +11 ;IHS/ITSC/CLS 12/31/2003 sends an HL7 message at examined
- IF $DATA(RASN)
- IF (RASN="EXAMINED")
- IF RAOSTS=6
- DO ^RAORDU
- +12 IF $PIECE($GET(RAORDB4),"^",5)=2
- IF (RAOSTS'=2)
- Begin DoDot:1
- +13 ; Prior request status complete ($P(RAORDB4,"^",5)=2), new request
- +14 ; status (RAOSTS) not complete & OE/RR version not less than 3 issue
- +15 ; roll back message
- +16 IF $$ORVR^RAORDU()'<3
- DO EN2^RAO7CH(RAOIFN)
- +17 ; Delete 'V' file pointers if PCE installed & outpatient
- +18 IF $PIECE(RAEXM0,"^",6)]""
- IF ($PIECE(^DIC(42,$PIECE(RAEXM0,"^",6),0),"^",3)'="D")
- QUIT
- +19 IF $$PCE^RAWORK()
- DO UNCOMPL^RAPCE1(RADFN,RADTI,RACNI)
- +20 QUIT
- End DoDot:1
- Q KILL RABLNK,RACAT,RAEXM0,RAEXOR,RAILP,RAMIFN,RAMOD,RAMODA,RAMODD,RAOIFN,RAORD0,RAORDB4,RAOSTS,RAPRC,RARSH,RASHA,X
- +1 IF '$DATA(N)!($DATA(RAOREA)<10)
- KILL RAOREA
- QUIT
- +2 IF $DATA(RAOREA)>1
- IF $GET(N)
- KILL RAOREA(N)
- IF $DATA(RAOREA)<10
- KILL RAOREA
- +3 QUIT
- +4 ;
- EXMCAN ; Update request status to cancel or hold.
- +1 NEW RAXIT
- SET RAXIT=0
- +2 SET RAOREA=$SELECT($DATA(RAOREA):RAOREA,1:$ORDER(^RA(75.2,"B",$SELECT($DATA(RADELFLG):"EXAM DELETED",1:"EXAM CANCELLED"),0)))
- +3 ;
- ASKCAN SET RA=$ORDER(^RADPT("AO",RAOIFN,RADFN,RADTI,0))
- +1 IF RA
- IF $ORDER(^RADPT("AO",RAOIFN,RADFN,RADTI,RA))
- Begin DoDot:1
- +2 ; If # descendents > 1 do not allow order to be deleted or canceled
- +3 NEW RAESTAT
- SET RAESTAT=$$EN1^RASETU(RAOIFN,RADFN)
- +4 ; all other exams have been cancelled
- IF +$PIECE(RAESTAT,"^",3)
- QUIT
- +5 ; if ramaining xams complete -or- at least one of the other
- SET RAXIT=1
- +6 ; xams not cancelled, take appropriate action, quit EXMCAN
- +7 ; all xams complete
- IF +RAESTAT=9
- SET RAOSTS=2
- DO ^RAORDU
- SET RAOSTS=0
- QUIT
- +8 WRITE !!?5,"Please note, however, that more than one procedure is associated"
- +9 WRITE !?5,"with the procedure's Parent request. The Parent request will not"
- +10 WRITE !?5,"be canceled or put or hold unless all the registered descendent"
- +11 WRITE !?5,"procedures are canceled or deleted.",!,$CHAR(7)
- +12 QUIT
- End DoDot:1
- IF RAXIT
- QUIT
- +13 WRITE !!,"Do you want to cancel the request associated with this exam"
- SET %=2
- DO YN^DICN
- SET RAOSTS=$SELECT(%=1:1,%=2:3,1:0)
- IF 'RAOSTS
- WRITE !!,"Required, enter 'YES' if the request should be cancelled or 'NO' to put",!,"it on hold."
- GOTO ASKCAN
- +14 IF RAOSTS=1
- IF $DATA(RADELFLG)
- Begin DoDot:1
- +15 ; Remove EXAM SET flag if parent order deleted
- +16 NEW DA,DIE,DR
- +17 SET DIE="^RADPT("_RADFN_",""DT"","
- SET DA(1)=RADFN
- SET DA=RADTI
- SET DR="5///@"
- +18 DO ^DIE
- +19 QUIT
- End DoDot:1
- +20 IF RAOSTS=3
- SET (DIE,DIC)="^RAO(75.1,"
- SET DIC(0)="AEQM"
- SET DA=RAOIFN
- SET DR="25"
- WRITE !
- DO ^DIE
- KILL DIE,DIC,DA,DR
- +21 DO ^RAORDU
- WRITE !?10,"...request status updated to ",$SELECT(RAOSTS=1:"discontinued",1:"hold"),"."
- +22 QUIT
- +23 ;
- EXMCOM ; Code moved to EXMCOM^RAORDC1 to save on space. To update request
- +1 ; statuses for complete exams.
- +2 DO EXMCOM^RAORDC1
- QUIT
- +3 ;
- DELMOD SET DA(1)=RAOIFN
- SET DA=RAMIFN
- SET DIK="^RAO(75.1,"_DA(1)_",""M"","
- DO ^DIK
- KILL DA,DIK
- SET RAMODD=""
- +1 QUIT
- +2 ;
- ADDMOD SET X=$SELECT($DATA(^RAMIS(71.2,RAILP,0)):$PIECE(^(0),"^"),1:"")
- IF X'=""
- IF '$DATA(^RAO(75.1,RAOIFN,"M",0))
- SET ^(0)="^75.1125PA^^"
- SET DIC(0)="L"
- SET DLAYGO=75.1
- SET DA(1)=RAOIFN
- SET DIC="^RAO(75.1,RAOIFN,""M"","
- DO ^DIC
- KILL DA,DIC
- SET RAMODA=""
- +1 QUIT
