GMTSRAD ; SLC/JER,KER HIN/GJC - Radiology Request Status ; 08/27/2002
;;2.7;Health Summary;**14,28,56**;Oct 20, 1995
;
; External References
; DBIA 3125 ^RADPT(
; DBIA 3125 ^RADPT("AO"
; DBIA 504 ^RAO(75.1
; DBIA 2056 $$GET1^DIQ (file 72)
; DBIA 2056 GETS^DIQ (file 70.03)
; DBIA 10015 EN^DIQ1 (file 75.1)
; DBIA 10104 $$LOW^XLFSTR
;
ENRAD ; Entry Point for HS only
N MAX K ^TMP("GMTSRAD",$J)
S MAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:99999)
Q:'$D(^RAO(75.1,"AS",DFN)) D GET
Q:'$D(^TMP("GMTSRAD",$J)) D LOOP
K ^TMP("GMTSRAD",$J)
Q
GET ; Extract radiology orders
N DA,DIC,DIQ,DR,GMI,GMOUT,GMP,GMRDT,GMSTAT,GMPRC,GMSDT,GMDOC S GMI=0
F S GMI=$O(^RAO(75.1,"AS",DFN,GMI)) Q:+GMI'>0!+$G(GMOUT) D
. S DA=0 F S DA=$O(^RAO(75.1,"AS",DFN,GMI,DA)) Q:+DA'>0!+$G(GMOUT) D
. . N GMORD
. . S DIC="^RAO(75.1,",DIQ="GMORD(",DIQ(0)="IE",DR="2;5;14;16;23"
. . D EN^DIQ1
. . S GMRDT=$G(GMORD(75.1,DA,16,"I")),GMSTAT=$G(GMORD(75.1,DA,5,"E"))
. . I $S(GMRDT>GMTSEND:1,GMRDT<GMTSBEG:1,1:0) Q
. . S GMPRC=$G(GMORD(75.1,DA,2,"E")),GMP=$G(GMORD(75.1,DA,2,"I"))
. . S GMSDT=$G(GMORD(75.1,DA,23,"I")),GMDOC=$E($G(GMORD(75.1,DA,14,"E")),1,14)
. . I $L(GMPRC)>24 S GMPRC=$$WRAP^GMTSORC(GMPRC,24)
. . S GMSTAT=$E($$LOW^XLFSTR(GMSTAT))
. . S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP,0)=""
. . S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP)=GMRDT_U_GMSTAT_U_GMPRC_U_GMSDT_U_GMDOC
. . D REG(DA,GMP)
Q
HDR ; Write column header
D CKP^GMTSUP Q:$D(GMTSQIT) W "Req DT",?11,"Status",?22,"Procedure",?48,"Scheduled DT",?66,"Provider",!
D CKP^GMTSUP Q:$D(GMTSQIT) W !
Q
LOOP ; Loops through ^TMP("GMTSRAD",$J,
N GMCNT,GMI,GMORD,GMRDT,GMREC S (GMCNT,GMRDT)=0
D HDR
F S GMRDT=$O(^TMP("GMTSRAD",$J,GMRDT)) Q:+GMRDT'>0!(GMCNT=MAX) D
. S GMORD=0
. F S GMORD=$O(^TMP("GMTSRAD",$J,GMRDT,GMORD)) Q:+GMORD'>0!(GMCNT=MAX) D
. . S GMI=0
. . F S GMI=$O(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI)) Q:+GMI'>0!(GMCNT=MAX) D
. . . S GMREC(0)=$G(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI,0))
. . . S GMREC=$G(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI)),GMCNT=GMCNT+1 D WRT
Q
WRT ; Write record
N GMII,GMRDT1,GMSTAT,GMPRC,GMSDT,GMDOC,GMPRO,X
S X=+GMREC D REGDT4^GMTSU S GMRDT1=X,GMSTAT=$P(GMREC,U,2)
S GMPRC=$P(GMREC,U,3)
S X=$P(GMREC,U,4) D REGDTM4^GMTSU S GMSDT=X,GMDOC=$P(GMREC,U,5)
D CKP^GMTSUP Q:$D(GMTSQIT) D
. I GMTSNPG D HDR
. W GMRDT1,?13,GMSTAT W:+$G(GMREC(0)) ?17,"Ord: "
. W ?22,$P(GMPRC,"|"),?48,GMSDT,?66,GMDOC,!
F GMII=2:1:$L(GMPRC,"|") D
. D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR W ?22,$P(GMPRC,"|",GMII),!
I +$G(GMREC(0)) D
. D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
. S GMRCNT=0 W ?13,"Actual: "
. F S GMRCNT=$O(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI,GMRCNT)) Q:GMRCNT'>0 D
.. S GMPRO=$G(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI,GMRCNT))
.. D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,$P(GMPRO,"|"),!
.. F GMII=2:1:$L(GMPRO,"|") D
... D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR W ?22,$P(GMPRO,"|",GMII),!
... Q
.. Q
. Q
Q
;
REG(DA,GMP) ; Registered Order Parent/Differs
;
; If the order has been registered, check to see if the
; procedure ordered is a parent or if the ordered procedure
; differs from the registered procedure.
;
; Input: DA -> ien of the order in file 75.1
; : GMP -> ien of the ordered procedure
Q:'$D(^RADPT("AO",DA))
N GMCNI,GMDFN,GMDTI,GMREG,GMRCNT,GMY2 S GMRCNT=0
S GMDFN=+$O(^RADPT("AO",DA,0)) Q:'GMDFN
S GMDTI=+$O(^RADPT("AO",DA,GMDFN,0)) Q:'GMDTI
S GMY2=$G(^RADPT(GMDFN,"DT",GMDTI,0))
I '$P(GMY2,"^",5) D Q
. S GMCNI=+$O(^RADPT("AO",DA,GMDFN,GMDTI,0)) Q:GMCNI'>0
. D REG1(DA,GMDFN,GMDTI,GMCNI,GMP)
. Q
S GMCNI=0
F S GMCNI=$O(^RADPT(GMDFN,"DT",GMDTI,"P",GMCNI)) Q:GMCNI'>0 D
. D REG1(DA,GMDFN,GMDTI,GMCNI,GMP)
. Q
Q
;
REG1(DA,GMDFN,GMDTI,GMCNI,GMP) ; Registered Order Differs
;
; Check if the ordered procedure differs from
; the registered procedure.
;
; Input: DA -> Order (75.1) ien
; GMDFN -> ien of the patient
; GMDTI -> inv. date/time of exam
; GMCNI -> ien of each case
; GMP -> ien of the procedure for the order
;
; Sets: ^TMP("GMTSRAD",$J,inv Req Entered Date/Time,
; order ien,proc ien,
;
; 0)=1 if one of the following conditions exist:
; 1) the procedure ordered is not the procedure
; registered (exam not cancelled)
; 2) the ordered procedure is a parent and the
; descendent procedure(s) have been registered
; (exam not cancelled)
;
; Sets: ^TMP("GMTSRAD",$J,inv Req Entered Date/Time,
; order ien,proc ien,seq #)=Registered Procedure
N GMIEN,GMPRO,GMREG S GMRCNT=GMRCNT+1
S GMIEN=GMCNI_","_GMDTI_","_GMDFN_","
D GETS^DIQ(70.03,GMIEN,"2;3","IE","GMREG")
S GMPRO=GMREG(70.03,GMIEN,2,"E")
Q:GMPRO=""
Q:GMREG(70.03,GMIEN,3,"I")=""
Q:$$GET1^DIQ(72,GMREG(70.03,GMIEN,3,"I"),3,"I")=0
Q:GMP=GMREG(70.03,GMIEN,2,"I")
S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP,0)=1
S:$L(GMPRO)>24 GMPRO=$$WRAP^GMTSORC(GMPRO,24)
S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP,GMRCNT)=GMPRO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRAD 5329 printed Dec 13, 2024@01:59:57 Page 2
GMTSRAD ; SLC/JER,KER HIN/GJC - Radiology Request Status ; 08/27/2002
+1 ;;2.7;Health Summary;**14,28,56**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 3125 ^RADPT(
+5 ; DBIA 3125 ^RADPT("AO"
+6 ; DBIA 504 ^RAO(75.1
+7 ; DBIA 2056 $$GET1^DIQ (file 72)
+8 ; DBIA 2056 GETS^DIQ (file 70.03)
+9 ; DBIA 10015 EN^DIQ1 (file 75.1)
+10 ; DBIA 10104 $$LOW^XLFSTR
+11 ;
ENRAD ; Entry Point for HS only
+1 NEW MAX
KILL ^TMP("GMTSRAD",$JOB)
+2 SET MAX=$SELECT(+$GET(GMTSNDM)>0:GMTSNDM,1:99999)
+3 if '$DATA(^RAO(75.1,"AS",DFN))
QUIT
DO GET
+4 if '$DATA(^TMP("GMTSRAD",$JOB))
QUIT
DO LOOP
+5 KILL ^TMP("GMTSRAD",$JOB)
+6 QUIT
GET ; Extract radiology orders
+1 NEW DA,DIC,DIQ,DR,GMI,GMOUT,GMP,GMRDT,GMSTAT,GMPRC,GMSDT,GMDOC
SET GMI=0
+2 FOR
SET GMI=$ORDER(^RAO(75.1,"AS",DFN,GMI))
if +GMI'>0!+$GET(GMOUT)
QUIT
Begin DoDot:1
+3 SET DA=0
FOR
SET DA=$ORDER(^RAO(75.1,"AS",DFN,GMI,DA))
if +DA'>0!+$GET(GMOUT)
QUIT
Begin DoDot:2
+4 NEW GMORD
+5 SET DIC="^RAO(75.1,"
SET DIQ="GMORD("
SET DIQ(0)="IE"
SET DR="2;5;14;16;23"
+6 DO EN^DIQ1
+7 SET GMRDT=$GET(GMORD(75.1,DA,16,"I"))
SET GMSTAT=$GET(GMORD(75.1,DA,5,"E"))
+8 IF $SELECT(GMRDT>GMTSEND:1,GMRDT<GMTSBEG:1,1:0)
QUIT
+9 SET GMPRC=$GET(GMORD(75.1,DA,2,"E"))
SET GMP=$GET(GMORD(75.1,DA,2,"I"))
+10 SET GMSDT=$GET(GMORD(75.1,DA,23,"I"))
SET GMDOC=$EXTRACT($GET(GMORD(75.1,DA,14,"E")),1,14)
+11 IF $LENGTH(GMPRC)>24
SET GMPRC=$$WRAP^GMTSORC(GMPRC,24)
+12 SET GMSTAT=$EXTRACT($$LOW^XLFSTR(GMSTAT))
+13 SET ^TMP("GMTSRAD",$JOB,9999999-GMRDT,DA,+GMP,0)=""
+14 SET ^TMP("GMTSRAD",$JOB,9999999-GMRDT,DA,+GMP)=GMRDT_U_GMSTAT_U_GMPRC_U_GMSDT_U_GMDOC
+15 DO REG(DA,GMP)
End DoDot:2
End DoDot:1
+16 QUIT
HDR ; Write column header
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Req DT",?11,"Status",?22,"Procedure",?48,"Scheduled DT",?66,"Provider",!
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !
+3 QUIT
LOOP ; Loops through ^TMP("GMTSRAD",$J,
+1 NEW GMCNT,GMI,GMORD,GMRDT,GMREC
SET (GMCNT,GMRDT)=0
+2 DO HDR
+3 FOR
SET GMRDT=$ORDER(^TMP("GMTSRAD",$JOB,GMRDT))
if +GMRDT'>0!(GMCNT=MAX)
QUIT
Begin DoDot:1
+4 SET GMORD=0
+5 FOR
SET GMORD=$ORDER(^TMP("GMTSRAD",$JOB,GMRDT,GMORD))
if +GMORD'>0!(GMCNT=MAX)
QUIT
Begin DoDot:2
+6 SET GMI=0
+7 FOR
SET GMI=$ORDER(^TMP("GMTSRAD",$JOB,GMRDT,GMORD,GMI))
if +GMI'>0!(GMCNT=MAX)
QUIT
Begin DoDot:3
+8 SET GMREC(0)=$GET(^TMP("GMTSRAD",$JOB,GMRDT,GMORD,GMI,0))
+9 SET GMREC=$GET(^TMP("GMTSRAD",$JOB,GMRDT,GMORD,GMI))
SET GMCNT=GMCNT+1
DO WRT
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
WRT ; Write record
+1 NEW GMII,GMRDT1,GMSTAT,GMPRC,GMSDT,GMDOC,GMPRO,X
+2 SET X=+GMREC
DO REGDT4^GMTSU
SET GMRDT1=X
SET GMSTAT=$PIECE(GMREC,U,2)
+3 SET GMPRC=$PIECE(GMREC,U,3)
+4 SET X=$PIECE(GMREC,U,4)
DO REGDTM4^GMTSU
SET GMSDT=X
SET GMDOC=$PIECE(GMREC,U,5)
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
Begin DoDot:1
+6 IF GMTSNPG
DO HDR
+7 WRITE GMRDT1,?13,GMSTAT
if +$GET(GMREC(0))
WRITE ?17,"Ord: "
+8 WRITE ?22,$PIECE(GMPRC,"|"),?48,GMSDT,?66,GMDOC,!
End DoDot:1
+9 FOR GMII=2:1:$LENGTH(GMPRC,"|")
Begin DoDot:1
+10 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
WRITE ?22,$PIECE(GMPRC,"|",GMII),!
End DoDot:1
+11 IF +$GET(GMREC(0))
Begin DoDot:1
+12 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+13 SET GMRCNT=0
WRITE ?13,"Actual: "
+14 FOR
SET GMRCNT=$ORDER(^TMP("GMTSRAD",$JOB,GMRDT,GMORD,GMI,GMRCNT))
if GMRCNT'>0
QUIT
Begin DoDot:2
+15 SET GMPRO=$GET(^TMP("GMTSRAD",$JOB,GMRDT,GMORD,GMI,GMRCNT))
+16 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?21,$PIECE(GMPRO,"|"),!
+17 FOR GMII=2:1:$LENGTH(GMPRO,"|")
Begin DoDot:3
+18 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
WRITE ?22,$PIECE(GMPRO,"|",GMII),!
+19 QUIT
End DoDot:3
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 QUIT
+23 ;
REG(DA,GMP) ; Registered Order Parent/Differs
+1 ;
+2 ; If the order has been registered, check to see if the
+3 ; procedure ordered is a parent or if the ordered procedure
+4 ; differs from the registered procedure.
+5 ;
+6 ; Input: DA -> ien of the order in file 75.1
+7 ; : GMP -> ien of the ordered procedure
+8 if '$DATA(^RADPT("AO",DA))
QUIT
+9 NEW GMCNI,GMDFN,GMDTI,GMREG,GMRCNT,GMY2
SET GMRCNT=0
+10 SET GMDFN=+$ORDER(^RADPT("AO",DA,0))
if 'GMDFN
QUIT
+11 SET GMDTI=+$ORDER(^RADPT("AO",DA,GMDFN,0))
if 'GMDTI
QUIT
+12 SET GMY2=$GET(^RADPT(GMDFN,"DT",GMDTI,0))
+13 IF '$PIECE(GMY2,"^",5)
Begin DoDot:1
+14 SET GMCNI=+$ORDER(^RADPT("AO",DA,GMDFN,GMDTI,0))
if GMCNI'>0
QUIT
+15 DO REG1(DA,GMDFN,GMDTI,GMCNI,GMP)
+16 QUIT
End DoDot:1
QUIT
+17 SET GMCNI=0
+18 FOR
SET GMCNI=$ORDER(^RADPT(GMDFN,"DT",GMDTI,"P",GMCNI))
if GMCNI'>0
QUIT
Begin DoDot:1
+19 DO REG1(DA,GMDFN,GMDTI,GMCNI,GMP)
+20 QUIT
End DoDot:1
+21 QUIT
+22 ;
REG1(DA,GMDFN,GMDTI,GMCNI,GMP) ; Registered Order Differs
+1 ;
+2 ; Check if the ordered procedure differs from
+3 ; the registered procedure.
+4 ;
+5 ; Input: DA -> Order (75.1) ien
+6 ; GMDFN -> ien of the patient
+7 ; GMDTI -> inv. date/time of exam
+8 ; GMCNI -> ien of each case
+9 ; GMP -> ien of the procedure for the order
+10 ;
+11 ; Sets: ^TMP("GMTSRAD",$J,inv Req Entered Date/Time,
+12 ; order ien,proc ien,
+13 ;
+14 ; 0)=1 if one of the following conditions exist:
+15 ; 1) the procedure ordered is not the procedure
+16 ; registered (exam not cancelled)
+17 ; 2) the ordered procedure is a parent and the
+18 ; descendent procedure(s) have been registered
+19 ; (exam not cancelled)
+20 ;
+21 ; Sets: ^TMP("GMTSRAD",$J,inv Req Entered Date/Time,
+22 ; order ien,proc ien,seq #)=Registered Procedure
+23 NEW GMIEN,GMPRO,GMREG
SET GMRCNT=GMRCNT+1
+24 SET GMIEN=GMCNI_","_GMDTI_","_GMDFN_","
+25 DO GETS^DIQ(70.03,GMIEN,"2;3","IE","GMREG")
+26 SET GMPRO=GMREG(70.03,GMIEN,2,"E")
+27 if GMPRO=""
QUIT
+28 if GMREG(70.03,GMIEN,3,"I")=""
QUIT
+29 if $$GET1^DIQ(72,GMREG(70.03,GMIEN,3,"I"),3,"I")=0
QUIT
+30 if GMP=GMREG(70.03,GMIEN,2,"I")
QUIT
+31 SET ^TMP("GMTSRAD",$JOB,9999999-GMRDT,DA,+GMP,0)=1
+32 if $LENGTH(GMPRO)>24
SET GMPRO=$$WRAP^GMTSORC(GMPRO,24)
+33 SET ^TMP("GMTSRAD",$JOB,9999999-GMRDT,DA,+GMP,GMRCNT)=GMPRO
+34 QUIT
