- RAUTL15 ;HISC/GJC-Skeleton rpt del if no data entered. ;11/5/99 12:33
- ;;5.0;Radiology/Nuclear Medicine;**5,10,47**;Mar 16, 1998;Build 21
- EN3(IEN74) ;Delete the skeleton report and pointer from Rad Pt file to
- ; report if user has not entered any report data (i.e. user ^'d out
- ; of report entry/edit after the system created a skeleton record).
- ; If the report is deleted, a bulletin will not be generated!
- N RA,RAPRG74,RATXT
- S RA(0)=$G(^RARPT(IEN74,0)) Q:RA(0)']"" 0
- I $O(^RARPT(IEN74,2005,0))>0 Q 0
- S RA("I")=$S(+$O(^RARPT(IEN74,"I",0))'>0:1,1:0)
- S RA("P")=$S($G(^RARPT(IEN74,"P"))="":1,1:0)
- S RA("R")=$S(+$O(^RARPT(IEN74,"R",0))'>0:1,1:0)
- S RA(5)=$P(RA(0),"^",5),RA(5)=$S(RA(5)]"":RA(5),1:"Null")
- I $L(RA(0),"^")'>6,("dD"[RA(5)),(RA("I")),(RA("P")),(RA("R")) D Q 1
- . N %,D,D0,DA,DIC,DIE,DIK,DQ,DR,X,Y
- . ; +++++ Delete Report Text pointer from the Examinations +++++
- . ; +++++ multiple in the Rad/Nuc Med Patient file +++++
- . ; +++++ if the data is xrefed, delete xref +++++
- . ; del other print member's REPORT TEXT xrefs, & set ptr to #74 as null
- . D DEL17^RARTE2(IEN74)
- . ; set RADFN, RADTI & RACNI if not defined! This situation will arise
- . ; when this code finds an incomplete Rad/Nuc Med Report while running
- . ; the post-init portion of the software.
- . S:'$D(RADFN) RADFN=$P(RA(0),"^",2)
- . S:'$D(RADTI) RADTI=9999999.9999-$P(RA(0),"^",3)
- . S:'$D(RACNI) RACNI=+$O(^RADPT(RADFN,"DT",RADTI,"P","B",+$P(RA(0),"^",4),0))
- . S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
- . D ENKILL^RAXREF(70.03,17,IEN74,.DA)
- . ; Delete pointers to the Rad/Nuc Med Report file i.e, '^RARPT('
- . ;*******
- . S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)="" K DA,X
- . ; +++++ Delete Report pntr from the Reports multiple in +++++
- . ; +++++ the Reports Batches file +++++
- . ; +++++ Delete Report pntr from the Report Distribution file +++++
- . D UPDTPNT^RAUTL9(IEN74)
- . ; +++++ Delete the entry from the Rad/Nuc Med Reports file +++++
- . S DA=IEN74,DIK="^RARPT(" D ^DIK
- . S RATXT(1)=" "
- . S RATXT(2)=" Report not complete. Must Delete......deletion complete!"
- . S RATXT(3)=$C(7) D MES^XPDUTL(.RATXT)
- . Q
- Q 0
- KMV ; kill miscellaneous variables
- K %DT,%I,%RET,%T
- K D,D0,D1,D2,D3,DA,DDER,DDH,DI,DIE,DIFLD,DIG,DIH,DISYS,DIU,DIW,DIWF,DIWL,DIWR,DIWT,DG,DK,DL,DM,DN,DR
- K POP
- Q
- ;
- CZECH(Y) ; check if an order can be cancelled, held, or scheduled.
- ; Y -> ien of the Rad/Nuc Med Orders file.
- ; Y1 -> if OE/RR > 2.5 & no order number: 1, else 0
- ; Called from: VALORD subroutine
- N RAORDER,Y1 S Y1=0
- S RAORDER(0)=$G(^RAO(75.1,+Y,0)) Q:RAORDER(0)']""
- I '$P(RAORDER(0),U,7),(+$$ORVR^RAORDU()>2.5) D
- . N Y2 ; 'Y2' is the procedure name
- . S Y1=1,Y2=$P($G(^RAMIS(71,+$P(RAORDER(0),U,2),0)),U)
- . D INV(RAOPTN,Y2)
- . Q
- Q Y1
- INV(X,X1) ; invalid action message called from the schedule/cancel or hold
- ; request options.
- ; X -> point of orgin (option) X1 -> procedure name
- ; Called from: CZECH subroutine
- S X=$$UP^XLFSTR($E(X,1,3)),X1=$S(X1]"":X1,1:"Unknown")
- W !!?3,"Sorry, can't "_$S(X="SCH":"schedule",X="CAN":"cancel",1:"hold")
- W " this request until OE/RR assigns an order number"
- W !?3,"for procedure: ",X1,!?3,"Please try later!"
- Q
- VALORD ; validate order data, i.e, has OE/RR order # and the site is running
- ; a version of OE/RR > 2.5 Called from: 2^RAORD, 3^RAORD & 4^RAORD
- N G1,G2,RA751 S G1=0
- F S G1=$O(RAORDS(G1)) Q:G1'>0 D
- . S G2=$$CZECH(+$G(RAORDS(G1))) K:G2 RAORDS(G1)
- . Q
- Q
- DPROC(RADFN,RADTI,RACNI,RAOIFN) ; Determine if the ordered procedure is
- ; different from the registered procedure.
- ; Input Variables: RADFN-Patient DFN
- ; RADTI-inverse DT of exam (if exists)
- ; RACNI-IEN on the case node (if exists)
- ; RAOIFN-IEN of the order
- ; Output: null-procedures don't differ -OR- no order/exam
- ; not null-ordered proc_"^"_registered proc data
- ; registered procedure data includes imaging type, procedure
- ; type and CPT codes (if any)
- ;
- ; NOTE: The only time we don't set ^TMP($J,"RA DIFF PRC") is when
- ; we are using the 'Detailed Request Display' option and the ordered
- ; procedure is the same as the registered procedure. All other
- ; Request display options output the ordered procedure, the
- ; registered procedure and exam case number if the order
- ; is active.
- ;
- N RA7003,RA751
- S RA7003=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- S RA751=$G(^RAO(75.1,RAOIFN,0))
- Q:$P(RA7003,"^",2)=""!($P(RA751,"^",2)="") "" ; missing order or xam
- I '$D(RAOPT("ORDERPRINTS")),'$D(RAOPT("ORDERPRINTPAT")) Q:$P(RA7003,"^",2)=$P(RA751,"^",2) "" ; except for 2 print options, quit if req.prc=regis.prc
- N RA71,RACPT,RACSE,RAITY,RAPRC,RATY,X,Y
- S RACSE=$$RJ^XLFSTR($P(RA7003,"^"),5)
- N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
- S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACSE)
- S RA71=$G(^RAMIS(71,$P(RA7003,"^",2),0))
- S RACPT=$P($$NAMCODE^RACPTMSC(+$P(RA71,"^",9),DT),"^")
- S RAPRC=$E($$GET1^DIQ(71,+$P(RA7003,"^",2)_",",.01),1,36)
- S RAITY=$$GET1^DIQ(79.2,+$P(RA71,"^",12)_",",3)
- S RATY=$$GET1^DIQ(71,$P(RA7003,"^",2)_",",6)
- S RATY=$E(RATY,1)_$$LOW^XLFSTR($E(RATY,2,9999))
- ;
- I $$USESSAN^RAHLRU1() S X="",Y=RACNDSP_" "_RAPRC,Y(0)="("_RAITY_" "_RATY_" "_RACPT_")"
- I '$$USESSAN^RAHLRU1() S X="",Y=RACSE_" "_RAPRC,Y(0)="("_RAITY_" "_RATY_" "_RACPT_")"
- S Y(0)=Y(0)_" "_$E($P($G(^RA(72,+$P(RA7003,"^",3),0)),"^"),1,4)
- S $E(X,1,42)=Y,$E(X,44,70)=Y(0)
- Q X
- RAUTL15 ;HISC/GJC-Skeleton rpt del if no data entered. ;11/5/99 12:33
- +1 ;;5.0;Radiology/Nuclear Medicine;**5,10,47**;Mar 16, 1998;Build 21
- EN3(IEN74) ;Delete the skeleton report and pointer from Rad Pt file to
- +1 ; report if user has not entered any report data (i.e. user ^'d out
- +2 ; of report entry/edit after the system created a skeleton record).
- +3 ; If the report is deleted, a bulletin will not be generated!
- +4 NEW RA,RAPRG74,RATXT
- +5 SET RA(0)=$GET(^RARPT(IEN74,0))
- IF RA(0)']""
- QUIT 0
- +6 IF $ORDER(^RARPT(IEN74,2005,0))>0
- QUIT 0
- +7 SET RA("I")=$SELECT(+$ORDER(^RARPT(IEN74,"I",0))'>0:1,1:0)
- +8 SET RA("P")=$SELECT($GET(^RARPT(IEN74,"P"))="":1,1:0)
- +9 SET RA("R")=$SELECT(+$ORDER(^RARPT(IEN74,"R",0))'>0:1,1:0)
- +10 SET RA(5)=$PIECE(RA(0),"^",5)
- SET RA(5)=$SELECT(RA(5)]"":RA(5),1:"Null")
- +11 IF $LENGTH(RA(0),"^")'>6
- IF ("dD"[RA(5))
- IF (RA("I"))
- IF (RA("P"))
- IF (RA("R"))
- Begin DoDot:1
- +12 NEW %,D,D0,DA,DIC,DIE,DIK,DQ,DR,X,Y
- +13 ; +++++ Delete Report Text pointer from the Examinations +++++
- +14 ; +++++ multiple in the Rad/Nuc Med Patient file +++++
- +15 ; +++++ if the data is xrefed, delete xref +++++
- +16 ; del other print member's REPORT TEXT xrefs, & set ptr to #74 as null
- +17 DO DEL17^RARTE2(IEN74)
- +18 ; set RADFN, RADTI & RACNI if not defined! This situation will arise
- +19 ; when this code finds an incomplete Rad/Nuc Med Report while running
- +20 ; the post-init portion of the software.
- +21 IF '$DATA(RADFN)
- SET RADFN=$PIECE(RA(0),"^",2)
- +22 IF '$DATA(RADTI)
- SET RADTI=9999999.9999-$PIECE(RA(0),"^",3)
- +23 IF '$DATA(RACNI)
- SET RACNI=+$ORDER(^RADPT(RADFN,"DT",RADTI,"P","B",+$PIECE(RA(0),"^",4),0))
- +24 SET DA(2)=RADFN
- SET DA(1)=RADTI
- SET DA=RACNI
- +25 DO ENKILL^RAXREF(70.03,17,IEN74,.DA)
- +26 ; Delete pointers to the Rad/Nuc Med Report file i.e, '^RARPT('
- +27 ;*******
- +28 SET $PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)=""
- KILL DA,X
- +29 ; +++++ Delete Report pntr from the Reports multiple in +++++
- +30 ; +++++ the Reports Batches file +++++
- +31 ; +++++ Delete Report pntr from the Report Distribution file +++++
- +32 DO UPDTPNT^RAUTL9(IEN74)
- +33 ; +++++ Delete the entry from the Rad/Nuc Med Reports file +++++
- +34 SET DA=IEN74
- SET DIK="^RARPT("
- DO ^DIK
- +35 SET RATXT(1)=" "
- +36 SET RATXT(2)=" Report not complete. Must Delete......deletion complete!"
- +37 SET RATXT(3)=$CHAR(7)
- DO MES^XPDUTL(.RATXT)
- +38 QUIT
- End DoDot:1
- QUIT 1
- +39 QUIT 0
- KMV ; kill miscellaneous variables
- +1 KILL %DT,%I,%RET,%T
- +2 KILL D,D0,D1,D2,D3,DA,DDER,DDH,DI,DIE,DIFLD,DIG,DIH,DISYS,DIU,DIW,DIWF,DIWL,DIWR,DIWT,DG,DK,DL,DM,DN,DR
- +3 KILL POP
- +4 QUIT
- +5 ;
- CZECH(Y) ; check if an order can be cancelled, held, or scheduled.
- +1 ; Y -> ien of the Rad/Nuc Med Orders file.
- +2 ; Y1 -> if OE/RR > 2.5 & no order number: 1, else 0
- +3 ; Called from: VALORD subroutine
- +4 NEW RAORDER,Y1
- SET Y1=0
- +5 SET RAORDER(0)=$GET(^RAO(75.1,+Y,0))
- IF RAORDER(0)']""
- QUIT
- +6 IF '$PIECE(RAORDER(0),U,7)
- IF (+$$ORVR^RAORDU()>2.5)
- Begin DoDot:1
- +7 ; 'Y2' is the procedure name
- NEW Y2
- +8 SET Y1=1
- SET Y2=$PIECE($GET(^RAMIS(71,+$PIECE(RAORDER(0),U,2),0)),U)
- +9 DO INV(RAOPTN,Y2)
- +10 QUIT
- End DoDot:1
- +11 QUIT Y1
- INV(X,X1) ; invalid action message called from the schedule/cancel or hold
- +1 ; request options.
- +2 ; X -> point of orgin (option) X1 -> procedure name
- +3 ; Called from: CZECH subroutine
- +4 SET X=$$UP^XLFSTR($EXTRACT(X,1,3))
- SET X1=$SELECT(X1]"":X1,1:"Unknown")
- +5 WRITE !!?3,"Sorry, can't "_$SELECT(X="SCH":"schedule",X="CAN":"cancel",1:"hold")
- +6 WRITE " this request until OE/RR assigns an order number"
- +7 WRITE !?3,"for procedure: ",X1,!?3,"Please try later!"
- +8 QUIT
- VALORD ; validate order data, i.e, has OE/RR order # and the site is running
- +1 ; a version of OE/RR > 2.5 Called from: 2^RAORD, 3^RAORD & 4^RAORD
- +2 NEW G1,G2,RA751
- SET G1=0
- +3 FOR
- SET G1=$ORDER(RAORDS(G1))
- IF G1'>0
- QUIT
- Begin DoDot:1
- +4 SET G2=$$CZECH(+$GET(RAORDS(G1)))
- IF G2
- KILL RAORDS(G1)
- +5 QUIT
- End DoDot:1
- +6 QUIT
- DPROC(RADFN,RADTI,RACNI,RAOIFN) ; Determine if the ordered procedure is
- +1 ; different from the registered procedure.
- +2 ; Input Variables: RADFN-Patient DFN
- +3 ; RADTI-inverse DT of exam (if exists)
- +4 ; RACNI-IEN on the case node (if exists)
- +5 ; RAOIFN-IEN of the order
- +6 ; Output: null-procedures don't differ -OR- no order/exam
- +7 ; not null-ordered proc_"^"_registered proc data
- +8 ; registered procedure data includes imaging type, procedure
- +9 ; type and CPT codes (if any)
- +10 ;
- +11 ; NOTE: The only time we don't set ^TMP($J,"RA DIFF PRC") is when
- +12 ; we are using the 'Detailed Request Display' option and the ordered
- +13 ; procedure is the same as the registered procedure. All other
- +14 ; Request display options output the ordered procedure, the
- +15 ; registered procedure and exam case number if the order
- +16 ; is active.
- +17 ;
- +18 NEW RA7003,RA751
- +19 SET RA7003=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- +20 SET RA751=$GET(^RAO(75.1,RAOIFN,0))
- +21 ; missing order or xam
- IF $PIECE(RA7003,"^",2)=""!($PIECE(RA751,"^",2)="")
- QUIT ""
- +22 ; except for 2 print options, quit if req.prc=regis.prc
- IF '$DATA(RAOPT("ORDERPRINTS"))
- IF '$DATA(RAOPT("ORDERPRINTPAT"))
- IF $PIECE(RA7003,"^",2)=$PIECE(RA751,"^",2)
- QUIT ""
- +23 NEW RA71,RACPT,RACSE,RAITY,RAPRC,RATY,X,Y
- +24 SET RACSE=$$RJ^XLFSTR($PIECE(RA7003,"^"),5)
- +25 NEW RASSAN,RACNDSP
- SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
- +26 SET RACNDSP=$SELECT((RASSAN'=""):RASSAN,1:RACSE)
- +27 SET RA71=$GET(^RAMIS(71,$PIECE(RA7003,"^",2),0))
- +28 SET RACPT=$PIECE($$NAMCODE^RACPTMSC(+$PIECE(RA71,"^",9),DT),"^")
- +29 SET RAPRC=$EXTRACT($$GET1^DIQ(71,+$PIECE(RA7003,"^",2)_",",.01),1,36)
- +30 SET RAITY=$$GET1^DIQ(79.2,+$PIECE(RA71,"^",12)_",",3)
- +31 SET RATY=$$GET1^DIQ(71,$PIECE(RA7003,"^",2)_",",6)
- +32 SET RATY=$EXTRACT(RATY,1)_$$LOW^XLFSTR($EXTRACT(RATY,2,9999))
- +33 ;
- +34 IF $$USESSAN^RAHLRU1()
- SET X=""
- SET Y=RACNDSP_" "_RAPRC
- SET Y(0)="("_RAITY_" "_RATY_" "_RACPT_")"
- +35 IF '$$USESSAN^RAHLRU1()
- SET X=""
- SET Y=RACSE_" "_RAPRC
- SET Y(0)="("_RAITY_" "_RATY_" "_RACPT_")"
- +36 SET Y(0)=Y(0)_" "_$EXTRACT($PIECE($GET(^RA(72,+$PIECE(RA7003,"^",3),0)),"^"),1,4)
- +37 SET $EXTRACT(X,1,42)=Y
- SET $EXTRACT(X,44,70)=Y(0)
- +38 QUIT X
