source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRAD.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1GMTSRAD ; SLC/JER,KER HIN/GJC - Radiology Request Status ; 08/27/2002
2 ;;2.7;Health Summary;**14,28,56**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 3125 ^RADPT(
6 ; DBIA 3125 ^RADPT("AO"
7 ; DBIA 504 ^RAO(75.1
8 ; DBIA 2056 $$GET1^DIQ (file 72)
9 ; DBIA 2056 GETS^DIQ (file 70.03)
10 ; DBIA 10015 EN^DIQ1 (file 75.1)
11 ; DBIA 10104 $$LOW^XLFSTR
12 ;
13ENRAD ; Entry Point for HS only
14 N MAX K ^TMP("GMTSRAD",$J)
15 S MAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:99999)
16 Q:'$D(^RAO(75.1,"AS",DFN)) D GET
17 Q:'$D(^TMP("GMTSRAD",$J)) D LOOP
18 K ^TMP("GMTSRAD",$J)
19 Q
20GET ; Extract radiology orders
21 N DA,DIC,DIQ,DR,GMI,GMOUT,GMP,GMRDT,GMSTAT,GMPRC,GMSDT,GMDOC S GMI=0
22 F S GMI=$O(^RAO(75.1,"AS",DFN,GMI)) Q:+GMI'>0!+$G(GMOUT) D
23 . S DA=0 F S DA=$O(^RAO(75.1,"AS",DFN,GMI,DA)) Q:+DA'>0!+$G(GMOUT) D
24 . . N GMORD
25 . . S DIC="^RAO(75.1,",DIQ="GMORD(",DIQ(0)="IE",DR="2;5;14;16;23"
26 . . D EN^DIQ1
27 . . S GMRDT=$G(GMORD(75.1,DA,16,"I")),GMSTAT=$G(GMORD(75.1,DA,5,"E"))
28 . . I $S(GMRDT>GMTSEND:1,GMRDT<GMTSBEG:1,1:0) Q
29 . . S GMPRC=$G(GMORD(75.1,DA,2,"E")),GMP=$G(GMORD(75.1,DA,2,"I"))
30 . . S GMSDT=$G(GMORD(75.1,DA,23,"I")),GMDOC=$E($G(GMORD(75.1,DA,14,"E")),1,14)
31 . . I $L(GMPRC)>24 S GMPRC=$$WRAP^GMTSORC(GMPRC,24)
32 . . S GMSTAT=$E($$LOW^XLFSTR(GMSTAT))
33 . . S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP,0)=""
34 . . S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP)=GMRDT_U_GMSTAT_U_GMPRC_U_GMSDT_U_GMDOC
35 . . D REG(DA,GMP)
36 Q
37HDR ; Write column header
38 D CKP^GMTSUP Q:$D(GMTSQIT) W "Req DT",?11,"Status",?22,"Procedure",?48,"Scheduled DT",?66,"Provider",!
39 D CKP^GMTSUP Q:$D(GMTSQIT) W !
40 Q
41LOOP ; Loops through ^TMP("GMTSRAD",$J,
42 N GMCNT,GMI,GMORD,GMRDT,GMREC S (GMCNT,GMRDT)=0
43 D HDR
44 F S GMRDT=$O(^TMP("GMTSRAD",$J,GMRDT)) Q:+GMRDT'>0!(GMCNT=MAX) D
45 . S GMORD=0
46 . F S GMORD=$O(^TMP("GMTSRAD",$J,GMRDT,GMORD)) Q:+GMORD'>0!(GMCNT=MAX) D
47 . . S GMI=0
48 . . F S GMI=$O(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI)) Q:+GMI'>0!(GMCNT=MAX) D
49 . . . S GMREC(0)=$G(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI,0))
50 . . . S GMREC=$G(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI)),GMCNT=GMCNT+1 D WRT
51 Q
52WRT ; Write record
53 N GMII,GMRDT1,GMSTAT,GMPRC,GMSDT,GMDOC,GMPRO,X
54 S X=+GMREC D REGDT4^GMTSU S GMRDT1=X,GMSTAT=$P(GMREC,U,2)
55 S GMPRC=$P(GMREC,U,3)
56 S X=$P(GMREC,U,4) D REGDTM4^GMTSU S GMSDT=X,GMDOC=$P(GMREC,U,5)
57 D CKP^GMTSUP Q:$D(GMTSQIT) D
58 . I GMTSNPG D HDR
59 . W GMRDT1,?13,GMSTAT W:+$G(GMREC(0)) ?17,"Ord: "
60 . W ?22,$P(GMPRC,"|"),?48,GMSDT,?66,GMDOC,!
61 F GMII=2:1:$L(GMPRC,"|") D
62 . D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR W ?22,$P(GMPRC,"|",GMII),!
63 I +$G(GMREC(0)) D
64 . D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
65 . S GMRCNT=0 W ?13,"Actual: "
66 . F S GMRCNT=$O(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI,GMRCNT)) Q:GMRCNT'>0 D
67 .. S GMPRO=$G(^TMP("GMTSRAD",$J,GMRDT,GMORD,GMI,GMRCNT))
68 .. D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,$P(GMPRO,"|"),!
69 .. F GMII=2:1:$L(GMPRO,"|") D
70 ... D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR W ?22,$P(GMPRO,"|",GMII),!
71 ... Q
72 .. Q
73 . Q
74 Q
75 ;
76REG(DA,GMP) ; Registered Order Parent/Differs
77 ;
78 ; If the order has been registered, check to see if the
79 ; procedure ordered is a parent or if the ordered procedure
80 ; differs from the registered procedure.
81 ;
82 ; Input: DA -> ien of the order in file 75.1
83 ; : GMP -> ien of the ordered procedure
84 Q:'$D(^RADPT("AO",DA))
85 N GMCNI,GMDFN,GMDTI,GMREG,GMRCNT,GMY2 S GMRCNT=0
86 S GMDFN=+$O(^RADPT("AO",DA,0)) Q:'GMDFN
87 S GMDTI=+$O(^RADPT("AO",DA,GMDFN,0)) Q:'GMDTI
88 S GMY2=$G(^RADPT(GMDFN,"DT",GMDTI,0))
89 I '$P(GMY2,"^",5) D Q
90 . S GMCNI=+$O(^RADPT("AO",DA,GMDFN,GMDTI,0)) Q:GMCNI'>0
91 . D REG1(DA,GMDFN,GMDTI,GMCNI,GMP)
92 . Q
93 S GMCNI=0
94 F S GMCNI=$O(^RADPT(GMDFN,"DT",GMDTI,"P",GMCNI)) Q:GMCNI'>0 D
95 . D REG1(DA,GMDFN,GMDTI,GMCNI,GMP)
96 . Q
97 Q
98 ;
99REG1(DA,GMDFN,GMDTI,GMCNI,GMP) ; Registered Order Differs
100 ;
101 ; Check if the ordered procedure differs from
102 ; the registered procedure.
103 ;
104 ; Input: DA -> Order (75.1) ien
105 ; GMDFN -> ien of the patient
106 ; GMDTI -> inv. date/time of exam
107 ; GMCNI -> ien of each case
108 ; GMP -> ien of the procedure for the order
109 ;
110 ; Sets: ^TMP("GMTSRAD",$J,inv Req Entered Date/Time,
111 ; order ien,proc ien,
112 ;
113 ; 0)=1 if one of the following conditions exist:
114 ; 1) the procedure ordered is not the procedure
115 ; registered (exam not cancelled)
116 ; 2) the ordered procedure is a parent and the
117 ; descendent procedure(s) have been registered
118 ; (exam not cancelled)
119 ;
120 ; Sets: ^TMP("GMTSRAD",$J,inv Req Entered Date/Time,
121 ; order ien,proc ien,seq #)=Registered Procedure
122 N GMIEN,GMPRO,GMREG S GMRCNT=GMRCNT+1
123 S GMIEN=GMCNI_","_GMDTI_","_GMDFN_","
124 D GETS^DIQ(70.03,GMIEN,"2;3","IE","GMREG")
125 S GMPRO=GMREG(70.03,GMIEN,2,"E")
126 Q:GMPRO=""
127 Q:GMREG(70.03,GMIEN,3,"I")=""
128 Q:$$GET1^DIQ(72,GMREG(70.03,GMIEN,3,"I"),3,"I")=0
129 Q:GMP=GMREG(70.03,GMIEN,2,"I")
130 S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP,0)=1
131 S:$L(GMPRO)>24 GMPRO=$$WRAP^GMTSORC(GMPRO,24)
132 S ^TMP("GMTSRAD",$J,9999999-GMRDT,DA,+GMP,GMRCNT)=GMPRO
133 Q
Note: See TracBrowser for help on using the repository browser.