Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAORDC

RAORDC.m

Go to the documentation of this file.
  1. RAORDC ;HISC/CAH,FPT,GJC,DAD AISC/RMO-Check Request Status against Exam Status ; Mar 24, 2020@11:52:36
  1. ;;5.0;Radiology/Nuclear Medicine;**113,124,162,166**;Mar 16, 1998;Build 2
  1. ;
  1. ;The variables RADFN, RADTI and RACNI must be defined. The variable
  1. ;RADELFLG is set when the exam is being deleted. This routine is
  1. ;called after an exam status is updated, to update the order status.
  1. ;Called from RAEDCN after exam cancel or delete, from RAESO after
  1. ;override single exam to complete, from RASTED after exam status is
  1. ;updated successfully, and from RAUTL1 after exam status update.
  1. 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)
  1. 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))
  1. ;
  1. ;Check for studies that are COMPLETE (w/order=9). May be single studies,
  1. ;multiple studies per patient event: examsets, printsets, add exams to
  1. ;last visit get radiation dose data if the proper conditions are met.
  1. I RAOSTS=2!(RAOSTS=6) D ; ACTIVE (6) or COMPLETE (2)
  1. .N RAIT,RAY2,RAY3 S RAY2=$G(^RADPT(RADFN,"DT",RADTI,0))
  1. .S RAIT=$P($G(^RA(79.2,+$P(RAY2,U,2),0)),U,3)
  1. .I RAIT'="RAD",(RAIT'="CT") Q
  1. .S RAIT=$S(RAIT="RAD":"FLUORO",1:"CT") ;MAG requires "FLUORO"
  1. .S RAY3=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. .Q:$P($G(^RA(72,+$P(RAY3,U,3),0)),U,3)'=9 ;must be COMPLETE
  1. .D GETDOSE^RADUTL ;RA*5.0*113 w/MAG*3.0*137
  1. .Q
  1. ;
  1. I $P($G(RAORDB4),"^",5)=2,(RAOSTS'=2) D
  1. . ; Prior request status complete ($P(RAORDB4,"^",5)=2), new request
  1. . ; status (RAOSTS) not complete & OE/RR version not less than 3 issue
  1. . ; roll back message
  1. . D:$$ORVR^RAORDU()'<3 EN2^RAO7CH(RAOIFN)
  1. . ; Delete 'V' file pointers if PCE installed & outpatient
  1. . I $P(RAEXM0,"^",6)]"",($P(^DIC(42,$P(RAEXM0,"^",6),0),"^",3)'="D") Q
  1. . D:$$PCE^RAWORK() UNCOMPL^RAPCE1(RADFN,RADTI,RACNI)
  1. . Q
  1. Q K RABLNK,RACAT,RAEXM0,RAEXOR,RAILP,RAMIFN,RAMOD,RAMODA,RAMODD,RAOIFN,RAORD0,RAORDB4,RAOSTS,RAPRC,RARSH,RASHA,X
  1. I '$D(N)!($D(RAOREA)<10) K RAOREA Q
  1. I $D(RAOREA)>1,$G(N) K RAOREA(N) I $D(RAOREA)<10 K RAOREA
  1. Q
  1. ;
  1. EXMCAN ; Update request status to cancel or hold.
  1. ;This logic is called based on changes for RA5P124.
  1. ;RA5P124 comments will be added where necessary.
  1. N RAXIT S RAXIT=0
  1. S RAOREA=$S($D(RAOREA):RAOREA,1:$O(^RA(75.2,"B",$S($D(RADELFLG):"EXAM DELETED",1:"EXAM CANCELLED"),0)))
  1. ;
  1. ASKCAN ;logic to determine whether studies tied to the order meet the criteria
  1. ;to discontinue or hold the order. At this point RAOIFN, RADFN, RADTI, RACNI
  1. ;RAY2 (70.02 node), RAY3 (70.03) node and RACAN124 are set.
  1. ;
  1. ;check for descendents
  1. S RA=$O(^RADPT("AO",RAOIFN,RADFN,RADTI,0))
  1. I RA,$O(^RADPT("AO",RAOIFN,RADFN,RADTI,RA)) D Q:RAXIT
  1. . ; If # descendents > 1 do not assume the order is to be deleted or canceled
  1. . N RAESTAT S RAESTAT=$$EN1^RASETU(RAOIFN,RADFN)
  1. . ;RAESTAT = min ORDER number value for all descendents_"^"_max ORDER number value for all descendents
  1. . ; _"^"_$S(All_desc ORDER number values=0:1,1:0)
  1. . Q:+$P(RAESTAT,"^",3) ; all other exams have been canceled
  1. . S RAXIT=1 ; if ramaining xams complete -or- at least one of the other
  1. . ; xams not cancelled, take appropriate action, quit EXMCAN
  1. . I +RAESTAT=9 S RAOSTS=2 D ^RAORDU S RAOSTS=0 Q ; all xams complete
  1. . W !!?5,"Please note, however, that more than one procedure is associated"
  1. . W !?5,"with the procedure's Parent request. The Parent request will not"
  1. . W !?5,"be canceled or put or hold unless all the registered descendent"
  1. . W !?5,"procedures are canceled or deleted.",!,$C(7)
  1. . Q
  1. ;
  1. ;RA5P166
  1. ;RAUSUNXF set in RAORDC, killed in RAEDCN1
  1. W ! S (RAOSTS,RAUSUNXF)=$$YNCAN() Q:RAOSTS=-1
  1. ;RA5P166
  1. ;W ! S RAOSTS=$$YNCAN() Q:RAOSTS=-1 ORIGINAL LINE
  1. I RAOSTS=1,$D(RADELFLG) D
  1. . ; Remove EXAM SET flag if parent order deleted
  1. . N DA,DIE,DR
  1. . S DIE="^RADPT("_RADFN_",""DT"",",DA(1)=RADFN,DA=RADTI,DR="5///@"
  1. . D ^DIE
  1. . Q
  1. ;// new w/P162 keep the default reason (order) //
  1. ;// unless the user selects another reason //
  1. I RAOSTS=1 D
  1. .N RAS S RAS=$$REASON(RAOSTS) S:+RAS>0 RAOREA=+RAS
  1. .Q
  1. I RAOSTS=3 D
  1. .N RAS S RAS=$$REASON(RAOSTS) S:+RAS>0 RAOREA=+RAS
  1. .S (DIE,DIC)="^RAO(75.1,",DIC(0)="AEQM",DA=RAOIFN,DR="25" W ! D ^DIE K DIE,DIC,DA,DR
  1. .Q
  1. ;// end P162 mods //
  1. D ^RAORDU W !?10,"...request status updated to ",$S(RAOSTS=1:"discontinued",1:"hold"),"."
  1. Q
  1. ;
  1. EXMCOM ; Code moved to EXMCOM^RAORDC1 to save on space. To update request
  1. ; statuses for complete exams.
  1. D EXMCOM^RAORDC1 Q
  1. ;
  1. DELMOD S DA(1)=RAOIFN,DA=RAMIFN,DIK="^RAO(75.1,"_DA(1)_",""M""," D ^DIK K DA,DIK S RAMODD=""
  1. Q
  1. ;
  1. 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=""
  1. Q
  1. ;
  1. YNCAN() ;ask if the order is to be canceled
  1. ;DIR returns:
  1. ; X - Unprocessed user response
  1. ; Y - Processed user response.
  1. N %,DIR,DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="Y",DIR("B")="No"
  1. S DIR("?",1)="Required, enter 'YES' If the request should be cancelled or 'NO' to put"
  1. S DIR("?")="it on hold."
  1. S DIR("A")="Do you want to cancel the request associated with this exam"
  1. D ^DIR
  1. ;Yes/No: Y=1 for yes/cancel; else Y=0 for no/hold
  1. ;
  1. Q $S(Y=1:1,Y=0:3,1:-1)
  1. ;
  1. REASON(RAOSTS) ;cancel/hold reason using DIR
  1. ; RAOSTS - the request status selected by the user.
  1. ; 1 = discontinued/cancel; 3 = hold
  1. ; return: IEN^.01 of IEN
  1. ; -1^ (if nothing selected, timeout or up arrow)
  1. N %,DIR,DIRUT,DTOUT,DUOUT,RAREAY,X,Y
  1. S DIR(0)="POA^75.2:EZ"
  1. S DIR("A")="Select the '"_$S(RAOSTS=1:"cancel",1:"hold")_"' reason for this order: "
  1. S DIR("S")="I $P(^(0),U,2)=RAOSTS!($P(^(0),U,2)=9)" W ! D ^DIR
  1. I $D(DIRUT)#2 D Q RAREAY
  1. .S RAREAY="-1^"
  1. .Q
  1. E S RAREAY=Y
  1. Q RAREAY
  1. ;