source: FOIAVistA/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJSUM.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1DGJSUM ;ALB/MAF - Interface routine with Discharge Summary Package - Jan 26 1993
2 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
3CHECK(DFN,DGJTDT,DGJPARM,DGJIRTDA,DGJT,DGJFLG,DGJTYP) ;Check to see if there is an IRT entry for a deficiency type.
4 ;Input variables: DFN
5 ; DGJTDT = Event Date
6 ; DGJPARM = Division Parameters
7 ; DGJIRTDA= Incomplete Records IFN
8 ; DGJT = Array variables
9 ; DGJT("DIV") = Division
10 ; DGJT("AD#") = Admission IFN
11 ; DGJT("WARD")= Ward
12 ; DGJT("TS") = Treating Specialty
13 ; DGJT("ADDT") = Admission Date
14 ; DGJFLG = returns '1' if new entry created
15 ; (optional) DGJTYP = Pointer to file #393.3 IRT Def. Type
16 N DGJOUT
17 S DGJPARM=$G(^DG(40.8,+$G(DGJT("DIV")),"DT"))
18 Q:'+DGJPARM ;If IRT not turned on
19 S DGJTYP=$G(DGJTYP,+$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))
20 I DGJIRTDA]"",$D(^VAS(393,DGJIRTDA,0)) I '$D(^VAS(393,DGJIRTDA,"DT"))!($D(^VAS(393,DGJIRTDA,"DT"))&($P($G(^("DT")),"^",1)']"")) S DGJFLG=1 Q
21 I DGJIRTDA]"",$D(^VAS(393,DGJIRTDA,0)) Q
22 S DGJIRTDA=0 F S DGJIRTDA=$O(^VAS(393,"B",DFN,DGJIRTDA)) Q:+DGJIRTDA'>0 D I +$G(DGJOUT) Q
23 .I $P($G(^VAS(393,DGJIRTDA,0)),"^",2)=DGJTYP,$P($G(^VAS(393,DGJIRTDA,0)),"^",4)=$G(DGJT("AD#")) S DGJOUT=1 Q
24 I 'DGJIRTDA D ADD Q
25 Q
26ADD ;Create an IRT entry
27 N DIC,DLAYGO,DR,DIE,DGJT9,DGJT10,DGJTSP,DGJTSV,DGJX,DGJY,DGJTEV,DGJTWARD
28 S DGJTSV=$S($G(DGJT("WARD"))]"":$P(^DIC(42,+$G(DGJT("WARD")),0),"^",3),1:"")
29 S:DGJTSV']"" DGJTSV=0 S DGJTSV=$S($D(^DG(393.1,"AC",DGJTSV)):$O(^(DGJTSV,0)),1:"") I DGJTSV']"" S DGJTSV=$O(^DG(393.1,"AC",0,0))
30 S DGJTSP=$O(^DGPM("ATS",DFN,+$G(DGJT("AD#")),0)),DGJTSP=$O(^(+DGJTSP,0)),DGJTSP=$O(^(+DGJTSP,0)),DGJTSP=$S($D(^DGPM(+DGJTSP,0)):^(0),1:"") ;last TS mvt
31 S DGJX=8,DGJY=2 D DOC S DGJT9=X,X=""
32 S DGJT10="" I $P(DGJPARM,"^",3) S DGJX=19,DGJY=4 D DOC S DGJT10=X
33 S DGJTEV=$S(DGJTDT]"":DGJTDT,1:$P(DGJT("ADDT"),"^",1)),DGJTWARD=$G(^DIC(42,$P($G(DGJT("WARD")),"^",1),44))
34 S DIC="^VAS(393,",DLAYGO=393,DIC(0)="L",X=DFN D FILE^DICN
35 S DGJIRTDA=+Y I +Y'>0 Q
36 L +^VAS(393,+DGJIRTDA):1 I '$T Q
37 S DR=".02////"_DGJTYP_";.03////"_DGJTEV_";.04////"_$G(DGJT("AD#"))_";.05////"_DGJTWARD_";.06////"_$G(DGJT("DIV"))_";.07////"_$P($G(DGJT("TS")),"^",1)_";.08////"_DGJTSV_";.09////"_DGJT9_";.1////"_DGJT10_";.12////"_DGJT9_";.13////1"
38 S DIE="^VAS(393,",DA=DGJIRTDA D ^DIE
39 L -^VAS(393,+DGJIRTDA)
40 S DGJFLG=1 Q
41EDIT(DGJIRTDA,DGJVDD,DGJVDB,DGJVDT,DGJVTB,DGJPARM) ;Edit an IRT file entry.
42 L +^VAS(393,+DGJIRTDA):1 I '$T Q
43 S DR="10.01////"_DGJVDD_";10.02////"_DGJVDB_";10.03////"_DGJVDT_";10.04///"_DGJVTB_";10.05///@;10.06///@;10.07///@;10.08///@"
44 S DIE="^VAS(393,",DA=DGJIRTDA D ^DIE,STAT1
45 L -^VAS(393,+DGJIRTDA)
46 Q
47DCSDEL(DGJIRTDA,DGJPARM) ;If DCS is Deleted, IRT Rec should just contain a stub
48 L +^VAS(393,+DGJIRTDA):1 I '$T Q
49 S DR="10.01///@;10.02///@;10.03///@;10.04///@;10.05///@;10.06///@;10.07///@;10.08///@"
50 S DIE="^VAS(393,",DA=DGJIRTDA D ^DIE,STAT1
51 L -^VAS(393,+DGJIRTDA)
52 Q
53SIGUP(DGJIRTDA,DGJDS,DGJSB,DGJDR,DGJRB,DGJPARM) ;Update Signed and Reviewed fields.
54 L +^VAS(393,+DGJIRTDA):1 I '$T Q
55 S DR="10.05////"_DGJDS_";10.06////"_DGJSB_";10.07////"_DGJDR_";10.08////"_DGJRB
56 S DA=DGJIRTDA,DIE=393 D ^DIE,STAT1
57 L -^VAS(393,+DGJIRTDA)
58 Q
59STAT1 ;check on the status of the report after a change has been made.
60 N DGJNODE,DGJSTAT,DGJSTAT1
61 S DGJNODE=$G(^VAS(393,DGJIRTDA,"DT"))
62 I $P(DGJNODE,"^",1)']"" S DGJSTAT="INCOMPLETE" G STAT
63 I $P(DGJNODE,"^",3)']"" S DGJSTAT="DICTATED" G STAT
64 I $P(DGJNODE,"^",5)']"" S DGJSTAT="TRANSCRIBED" G STAT
65 I $P(DGJPARM,"^",3)=0 S DGJSTAT="SIGNED NO REVIEW" G STAT
66 I $P(DGJNODE,"^",7)']"" S DGJSTAT="SIGNED" G STAT
67 I $P(DGJPARM,"^",3)=1 S DGJSTAT="REVIEWED"
68STAT S DGJSTAT1=$O(^DG(393.2,"B",DGJSTAT,0)) S DIE="^VAS(393,",DA=DGJIRTDA,DR=".11////^S X=DGJSTAT1" D ^DIE K DR,DIE K DGJSTAT1
69 Q
70DOC ;provider resp.
71 S X=$P(DGJPARM,"^",DGJY)
72 S X=$S(X="A":$P(DGJTSP,"^",19),X="N":"",1:$P(DGJTSP,"^",8))
73 Q
Note: See TracBrowser for help on using the repository browser.