134 lines
5.1 KiB
Mathematica
134 lines
5.1 KiB
Mathematica
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
|