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

GMTSRAD.m

Go to the documentation of this file. 
  1. GMTSRAD ; SLC/JER,KER HIN/GJC - Radiology Request Status ; 08/27/2002
  1.  ;;2.7;Health Summary;**14,28,56**;Oct 20, 1995
  1.  ;
  1.  ; External References
  1.  ;   DBIA  3125  ^RADPT(
  1.  ;   DBIA  3125  ^RADPT("AO"
  1.  ;   DBIA   504  ^RAO(75.1
  1.  ;   DBIA  2056  $$GET1^DIQ (file 72)
  1.  ;   DBIA  2056  GETS^DIQ (file 70.03)
  1.  ;   DBIA 10015  EN^DIQ1 (file 75.1)
  1.  ;   DBIA 10104  $$LOW^XLFSTR
  1.  ;                  
  1. ENRAD ; Entry Point for HS only
  1.  N MAX K ^TMP("GMTSRAD",$J)
  1.  S MAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:99999)
  1.  Q:'$D(^RAO(75.1,"AS",DFN))  D GET
  1.  Q:'$D(^TMP("GMTSRAD",$J))  D LOOP
  1.  K ^TMP("GMTSRAD",$J)
  1.  Q
  1. GET ; Extract radiology orders
  1.  N DA,DIC,DIQ,DR,GMI,GMOUT,GMP,GMRDT,GMSTAT,GMPRC,GMSDT,GMDOC S GMI=0
  1.  F  S GMI=$O(^RAO(75.1,"AS",DFN,GMI)) Q:+GMI'>0!+$G(GMOUT)  D
  1.  . S DA=0 F  S DA=$O(^RAO(75.1,"AS",DFN,GMI,DA)) Q:+DA'>0!+$G(GMOUT)  D
  1.  . . N GMORD
  1.  . . S DIC="^RAO(75.1,",DIQ="GMORD(",DIQ(0)="IE",DR="2;5;14;16;23"
  1.  . . D EN^DIQ1
  1.  . . S GMRDT=$G(GMORD(75.1,DA,16,"I")),GMSTAT=$G(GMORD(75.1,DA,5,"E"))
  1.  . . I $S(GMRDT>GMTSEND:1,GMRDT<GMTSBEG:1,1:0) Q
  1.  . . S GMPRC=$G(GMORD(75.1,DA,2,"E")),GMP=$G(GMORD(75.1,DA,2,"I"))
  1.  . . S GMSDT=$G(GMORD(75.1,DA,23,"I")),GMDOC=$E($G(GMORD(75.1,DA,14,"E")),1,14)
  1.  . . I $L(GMPRC)>24 S GMPRC=$$WRAP^GMTSORC(GMPRC,24)
  1.  . . S GMSTAT=$E($$LOW^XLFSTR(GMSTAT))
  1.  . . S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP,0)=""
  1.  . . S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP)=GMRDT_U_GMSTAT_U_GMPRC_U_GMSDT_U_GMDOC
  1.  . . D REG(DA,GMP)
  1.  Q
  1. HDR ; Write column header
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  W "Req DT",?11,"Status",?22,"Procedure",?48,"Scheduled DT",?66,"Provider",!
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  W !
  1.  Q
  1. LOOP ; Loops through ^TMP("GMTSRAD",$J,
  1.  N GMCNT,GMI,GMORD,GMRDT,GMREC S (GMCNT,GMRDT)=0
  1.  D HDR
  1.  F  S GMRDT=$O(^TMP("GMTSRAD",$J,GMRDT)) Q:+GMRDT'>0!(GMCNT=MAX)  D
  1.  . S GMORD=0
  1.  . F  S GMORD=$O(^TMP("GMTSRAD",$J,GMRDT,GMORD)) Q:+GMORD'>0!(GMCNT=MAX)  D
  1.  . . S GMI=0
  1.  . . F  S GMI=$O(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI)) Q:+GMI'>0!(GMCNT=MAX)  D
  1.  . . . S GMREC(0)=$G(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI,0))
  1.  . . . S GMREC=$G(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI)),GMCNT=GMCNT+1 D WRT
  1.  Q
  1. WRT ; Write record
  1.  N GMII,GMRDT1,GMSTAT,GMPRC,GMSDT,GMDOC,GMPRO,X
  1.  S X=+GMREC D REGDT4^GMTSU S GMRDT1=X,GMSTAT=$P(GMREC,U,2)
  1.  S GMPRC=$P(GMREC,U,3)
  1.  S X=$P(GMREC,U,4) D REGDTM4^GMTSU S GMSDT=X,GMDOC=$P(GMREC,U,5)
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  D
  1.  . I GMTSNPG D HDR
  1.  . W GMRDT1,?13,GMSTAT W:+$G(GMREC(0)) ?17,"Ord: "
  1.  . W ?22,$P(GMPRC,"|"),?48,GMSDT,?66,GMDOC,!
  1.  F GMII=2:1:$L(GMPRC,"|") D
  1.  . D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HDR W ?22,$P(GMPRC,"|",GMII),!
  1.  I +$G(GMREC(0)) D
  1.  . D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HDR
  1.  . S GMRCNT=0 W ?13,"Actual: "
  1.  . F  S GMRCNT=$O(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI,GMRCNT)) Q:GMRCNT'>0  D
  1.  .. S GMPRO=$G(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI,GMRCNT))
  1.  .. D CKP^GMTSUP Q:$D(GMTSQIT)  W ?21,$P(GMPRO,"|"),!
  1.  .. F GMII=2:1:$L(GMPRO,"|") D
  1.  ... D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HDR W ?22,$P(GMPRO,"|",GMII),!
  1.  ... Q
  1.  .. Q
  1.  . Q
  1.  Q
  1.  ;                  
  1. REG(DA,GMP) ; Registered Order Parent/Differs
  1.  ;                 
  1.  ; If the order has been registered, check to see if the
  1.  ; procedure ordered is a parent or if the ordered procedure
  1.  ; differs from the registered procedure.
  1.  ;                 
  1.  ; Input: DA  -> ien of the order in file 75.1
  1.  ;      : GMP -> ien of the ordered procedure
  1.  Q:'$D(^RADPT("AO",DA))
  1.  N GMCNI,GMDFN,GMDTI,GMREG,GMRCNT,GMY2 S GMRCNT=0
  1.  S GMDFN=+$O(^RADPT("AO",DA,0)) Q:'GMDFN
  1.  S GMDTI=+$O(^RADPT("AO",DA,GMDFN,0)) Q:'GMDTI
  1.  S GMY2=$G(^RADPT(GMDFN,"DT",GMDTI,0))
  1.  I '$P(GMY2,"^",5) D  Q
  1.  . S GMCNI=+$O(^RADPT("AO",DA,GMDFN,GMDTI,0)) Q:GMCNI'>0
  1.  . D REG1(DA,GMDFN,GMDTI,GMCNI,GMP)
  1.  . Q
  1.  S GMCNI=0
  1.  F  S GMCNI=$O(^RADPT(GMDFN,"DT",GMDTI,"P",GMCNI)) Q:GMCNI'>0  D
  1.  . D REG1(DA,GMDFN,GMDTI,GMCNI,GMP)
  1.  . Q
  1.  Q
  1.  ;                  
  1. REG1(DA,GMDFN,GMDTI,GMCNI,GMP) ; Registered Order Differs
  1.  ;                    
  1.  ; Check if the ordered procedure differs from
  1.  ; the registered procedure.
  1.  ;                         
  1.  ; Input: DA    -> Order (75.1) ien
  1.  ;        GMDFN -> ien of the patient
  1.  ;        GMDTI -> inv. date/time of exam
  1.  ;        GMCNI -> ien of each case
  1.  ;        GMP   -> ien of the procedure for the order
  1.  ;                     
  1.  ; Sets: ^TMP("GMTSRAD",$J,inv Req Entered Date/Time,
  1.  ;       order ien,proc ien,
  1.  ;                   
  1.  ;            0)=1 if one of the following conditions exist:
  1.  ;            1) the procedure ordered is not the procedure
  1.  ;               registered (exam not cancelled)
  1.  ;            2) the ordered procedure is a parent and the
  1.  ;               descendent procedure(s) have been registered
  1.  ;               (exam not cancelled)
  1.  ;                   
  1.  ; Sets: ^TMP("GMTSRAD",$J,inv Req Entered Date/Time,
  1.  ;       order ien,proc ien,seq #)=Registered Procedure
  1.  N GMIEN,GMPRO,GMREG S GMRCNT=GMRCNT+1
  1.  S GMIEN=GMCNI_","_GMDTI_","_GMDFN_","
  1.  D GETS^DIQ(70.03,GMIEN,"2;3","IE","GMREG")
  1.  S GMPRO=GMREG(70.03,GMIEN,2,"E")
  1.  Q:GMPRO=""
  1.  Q:GMREG(70.03,GMIEN,3,"I")=""
  1.  Q:$$GET1^DIQ(72,GMREG(70.03,GMIEN,3,"I"),3,"I")=0
  1.  Q:GMP=GMREG(70.03,GMIEN,2,"I")
  1.  S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP,0)=1
  1.  S:$L(GMPRO)>24 GMPRO=$$WRAP^GMTSORC(GMPRO,24)
  1.  S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP,GMRCNT)=GMPRO
  1.  Q