- RAORDC1 ;HISC/GJC-Continuation of the RAORDC routine. ; Jul 05, 2022@11:08:24
- ;;5.0;Radiology/Nuclear Medicine;**192**;Mar 16, 1998;Build 1
- ;
- EXMCOM ; Called from EXMCOM^RAORDC, for updating request statuses for
- ; complete exams.
- K RAPRC,RACAT,RAPIFN,RARSH,RASHA,RAMIFN,RAMOD,RAMODA,RAMODD
- N RAPRGST S RAPRGST=$P(RAORD0,"^",13)
- I $P($G(RAEXM0),"^",25) D D SETU Q
- . N %,D,D0,DI,DIC,DIE,DQ,DR,X,Y
- . S DIE="^RAO(75.1,",DR="11///Y",DA=RAOIFN D ^DIE
- . Q
- S:$P(RAEXM0,"^",2)'=$P(RAORD0,"^",2) RAPRC=$P(RAEXM0,"^",2)
- S:$P(RAEXM0,"^",4)'=$P(RAORD0,"^",4) RACAT=""""_$P(RAEXM0,"^",4)_""""
- S RARSH=$S($P(RAORD0,"^",4)="R"&($P(RAEXM0,"^",4)'="R"):"@",$P(RAEXM0,"^",4)="R"&($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"R"))):"^S X="_""""_^("R")_"""",1:"") K:RARSH="" RARSH
- S RASHA=$S("CS"[$P(RAORD0,"^",4)&("CS"'[$P(RAEXM0,"^",4)):"@","CS"[$P(RAEXM0,"^",4)&($P(RAEXM0,"^",9)'=""):"^S X="_$P(RAEXM0,"^",9),1:"") K:RASHA="" RASHA
- S:$P(RAEXM0,"^",14)'=$P(RAORD0,"^",14)&($P(RAEXM0,"^",14)) RAPIFN=$P(RAEXM0,"^",14)
- ; don't del/add modifiers to order file
- ; remove most fields from DR string to prevent chang'g them in the order
- S DA=RAOIFN,DIE="^RAO(75.1,",DR="11////^S X=""n"""
- D ^DIE K DE,DQ,DIE,DR
- K RAMOD F I=0:0 S I=$O(^RAO(75.1,RAOIFN,"M","B",I)) Q:'I I $D(^RAMIS(71.2,+I,0)) S RAMOD=$S('$D(RAMOD):$P(^(0),"^"),1:RAMOD_", "_$P(^(0),"^"))
- SETU ; above code is skipped if procedure is parent
- S $P(RABLNK," ",40)=""
- I $$ORVR^RAORDU()=2.5,$D(^RAO(75.1,+RAOIFN,0)),$D(^RAMIS(71,+$P(^(0),"^",2),0)) S (RAPRC,ORETURN("ORTX",1))=$E($P(^(0),"^"),1,40)_"," D
- .I $D(RAMOD) S ORETURN("ORTX",2)="Modifiers: "_$E(RAMOD,1,80)_","
- .S ORETURN("ORTX",3)="Urgency: "_$S($P(RAORD0,"^",6)=1:"STAT",$P(RAORD0,"^",6)=2:"URGENT",1:"ROUTINE")_","
- .I $P(RAORD0,"^",19)]"" S X=$P(RAORD0,"^",19),ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Transport: "_$S(X="a":"AMBULATORY",X="p":"PORTABLE",X="s":"STRETCHER",1:"WHEELCHAIR")_","
- .I $P($G(^DPT(+RADFN,0)),"^",2)'="M" S ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Pregnant: "_$S(RAPRGST="n":"NO",RAPRGST="y":"YES",RAPRGST="u":"UNKNOWN",1:"")
- .S ORETURN("ORIT")=$P(^RAO(75.1,+RAOIFN,0),"^",2)_";RAMIS(71,"
- I '$D(RAF1),('$P(RAEXM0,"^",25)),($$CICHO()=1) D ; if orphan, display text now (p192)
- . W !?3,"...will now designate request status as 'COMPLETE'..."
- . Q
- D ^RAORDU ; Update the request status
- I '$D(RAF1),('$P(RAEXM0,"^",25)),($$CICHO()=1) D ; if orphan, display text now (p192)
- . W !?10,"...request status successfully updated."
- . Q
- Q
- CICHO() ;quiet - suppress output to screen? p192
- ; return: 0 if $D(ZTQUEUED)#2
- ; 0 if $G(RAQUIET,0)=1
- ; 1 if '$D(ZTQUEUED)#2 & $G(RAQUIET)'=1
- ; Note: check if RAQUIET set in EN1^RAHLO
- Q:$D(ZTQUEUED)#2 0
- Q:$G(RAQUIET,0)=1 0
- Q 1 ;don't suppress
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAORDC1 2786 printed Mar 13, 2025@21:43 Page 2
- RAORDC1 ;HISC/GJC-Continuation of the RAORDC routine. ; Jul 05, 2022@11:08:24
- +1 ;;5.0;Radiology/Nuclear Medicine;**192**;Mar 16, 1998;Build 1
- +2 ;
- EXMCOM ; Called from EXMCOM^RAORDC, for updating request statuses for
- +1 ; complete exams.
- +2 KILL RAPRC,RACAT,RAPIFN,RARSH,RASHA,RAMIFN,RAMOD,RAMODA,RAMODD
- +3 NEW RAPRGST
- SET RAPRGST=$PIECE(RAORD0,"^",13)
- +4 IF $PIECE($GET(RAEXM0),"^",25)
- Begin DoDot:1
- +5 NEW %,D,D0,DI,DIC,DIE,DQ,DR,X,Y
- +6 SET DIE="^RAO(75.1,"
- SET DR="11///Y"
- SET DA=RAOIFN
- DO ^DIE
- +7 QUIT
- End DoDot:1
- DO SETU
- QUIT
- +8 if $PIECE(RAEXM0,"^",2)'=$PIECE(RAORD0,"^",2)
- SET RAPRC=$PIECE(RAEXM0,"^",2)
- +9 if $PIECE(RAEXM0,"^",4)'=$PIECE(RAORD0,"^",4)
- SET RACAT=""""_$PIECE(RAEXM0,"^",4)_""""
- +10 SET RARSH=$SELECT($PIECE(RAORD0,"^",4)="R"&($PIECE(RAEXM0,"^",4)'="R"):"@",$PIECE(RAEXM0,"^",4)="R"&($DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"R"))):"^S X="_""""_^("R")_"""",1:"")
- if RARSH=""
- KILL RARSH
- +11 SET RASHA=$SELECT("CS"[$PIECE(RAORD0,"^",4)&("CS"'[$PIECE(RAEXM0,"^",4)):"@","CS"[$PIECE(RAEXM0,"^",4)&($PIECE(RAEXM0,"^",9)'=""):"^S X="_$PIECE(RAEXM0,"^",9),1:"")
- if RASHA=""
- KILL RASHA
- +12 if $PIECE(RAEXM0,"^",14)'=$PIECE(RAORD0,"^",14)&($PIECE(RAEXM0,"^",14))
- SET RAPIFN=$PIECE(RAEXM0,"^",14)
- +13 ; don't del/add modifiers to order file
- +14 ; remove most fields from DR string to prevent chang'g them in the order
- +15 SET DA=RAOIFN
- SET DIE="^RAO(75.1,"
- SET DR="11////^S X=""n"""
- +16 DO ^DIE
- KILL DE,DQ,DIE,DR
- +17 KILL RAMOD
- FOR I=0:0
- SET I=$ORDER(^RAO(75.1,RAOIFN,"M","B",I))
- if 'I
- QUIT
- IF $DATA(^RAMIS(71.2,+I,0))
- SET RAMOD=$SELECT('$DATA(RAMOD):$PIECE(^(0),"^"),1:RAMOD_", "_$PIECE(^(0),"^"))
- SETU ; above code is skipped if procedure is parent
- +1 SET $PIECE(RABLNK," ",40)=""
- +2 IF $$ORVR^RAORDU()=2.5
- IF $DATA(^RAO(75.1,+RAOIFN,0))
- IF $DATA(^RAMIS(71,+$PIECE(^(0),"^",2),0))
- SET (RAPRC,ORETURN("ORTX",1))=$EXTRACT($PIECE(^(0),"^"),1,40)_","
- Begin DoDot:1
- +3 IF $DATA(RAMOD)
- SET ORETURN("ORTX",2)="Modifiers: "_$EXTRACT(RAMOD,1,80)_","
- +4 SET ORETURN("ORTX",3)="Urgency: "_$SELECT($PIECE(RAORD0,"^",6)=1:"STAT",$PIECE(RAORD0,"^",6)=2:"URGENT",1:"ROUTINE")_","
- +5 IF $PIECE(RAORD0,"^",19)]""
- SET X=$PIECE(RAORD0,"^",19)
- SET ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Transport: "_$SELECT(X="a":"AMBULATORY",X="p":"PORTABLE",X="s":"STRETCHER",1:"WHEELCHAIR")_","
- +6 IF $PIECE($GET(^DPT(+RADFN,0)),"^",2)'="M"
- SET ORETURN("ORTX",3)=ORETURN("ORTX",3)_" Pregnant: "_$SELECT(RAPRGST="n":"NO",RAPRGST="y":"YES",RAPRGST="u":"UNKNOWN",1:"")
- +7 SET ORETURN("ORIT")=$PIECE(^RAO(75.1,+RAOIFN,0),"^",2)_";RAMIS(71,"
- End DoDot:1
- +8 ; if orphan, display text now (p192)
- IF '$DATA(RAF1)
- IF ('$PIECE(RAEXM0,"^",25))
- IF ($$CICHO()=1)
- Begin DoDot:1
- +9 WRITE !?3,"...will now designate request status as 'COMPLETE'..."
- +10 QUIT
- End DoDot:1
- +11 ; Update the request status
- DO ^RAORDU
- +12 ; if orphan, display text now (p192)
- IF '$DATA(RAF1)
- IF ('$PIECE(RAEXM0,"^",25))
- IF ($$CICHO()=1)
- Begin DoDot:1
- +13 WRITE !?10,"...request status successfully updated."
- +14 QUIT
- End DoDot:1
- +15 QUIT
- CICHO() ;quiet - suppress output to screen? p192
- +1 ; return: 0 if $D(ZTQUEUED)#2
- +2 ; 0 if $G(RAQUIET,0)=1
- +3 ; 1 if '$D(ZTQUEUED)#2 & $G(RAQUIET)'=1
- +4 ; Note: check if RAQUIET set in EN1^RAHLO
- +5 if $DATA(ZTQUEUED)#2
- QUIT 0
- +6 if $GET(RAQUIET,0)=1
- QUIT 0
- +7 ;don't suppress
- QUIT 1
- +8 ;
