DGJSUM ;ALB/MAF - Interface routine with Discharge Summary Package - Jan 26 1993
;;5.3;Registration;**112,1015**;Aug 13, 1993;Build 21
CHECK(DFN,DGJTDT,DGJPARM,DGJIRTDA,DGJT,DGJFLG,DGJTYP) ;Check to see if there is an IRT entry for a deficiency type.
;Input variables: DFN
; DGJTDT = Event Date
; DGJPARM = Division Parameters
; DGJIRTDA= Incomplete Records IFN
; DGJT = Array variables
; DGJT("DIV") = Division
; DGJT("AD#") = Admission IFN
; DGJT("WARD")= Ward
; DGJT("TS") = Treating Specialty
; DGJT("ADDT") = Admission Date
; DGJFLG = returns '1' if new entry created
; (optional) DGJTYP = Pointer to file #393.3 IRT Def. Type
N DGJOUT
S DGJPARM=$G(^DG(40.8,+$G(DGJT("DIV")),"DT"))
Q:'+DGJPARM ;If IRT not turned on
S DGJTYP=$G(DGJTYP,+$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))
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
I DGJIRTDA]"",$D(^VAS(393,DGJIRTDA,0)) Q
S DGJIRTDA=0 F S DGJIRTDA=$O(^VAS(393,"B",DFN,DGJIRTDA)) Q:+DGJIRTDA'>0 D I +$G(DGJOUT) Q
.I $P($G(^VAS(393,DGJIRTDA,0)),"^",2)=DGJTYP,$P($G(^VAS(393,DGJIRTDA,0)),"^",4)=$G(DGJT("AD#")) S DGJOUT=1 Q
I 'DGJIRTDA D ADD Q
Q
ADD ;Create an IRT entry
N DIC,DLAYGO,DR,DIE,DGJT9,DGJT10,DGJTSP,DGJTSV,DGJX,DGJY,DGJTEV,DGJTWARD
S DGJTSV=$S($G(DGJT("WARD"))]"":$P(^DIC(42,+$G(DGJT("WARD")),0),"^",3),1:"")
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))
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
S DGJX=8,DGJY=2 D DOC S DGJT9=X,X=""
S DGJT10="" I $P(DGJPARM,"^",3) S DGJX=19,DGJY=4 D DOC S DGJT10=X
S DGJTEV=$S(DGJTDT]"":DGJTDT,1:$P(DGJT("ADDT"),"^",1)),DGJTWARD=$G(^DIC(42,$P($G(DGJT("WARD")),"^",1),44))
S DIC="^VAS(393,",DLAYGO=393,DIC(0)="L",X=DFN D FILE^DICN
S DGJIRTDA=+Y I +Y'>0 Q
L +^VAS(393,+DGJIRTDA):1 I '$T Q
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"
S DIE="^VAS(393,",DA=DGJIRTDA D ^DIE
L -^VAS(393,+DGJIRTDA)
S DGJFLG=1 Q
EDIT(DGJIRTDA,DGJVDD,DGJVDB,DGJVDT,DGJVTB,DGJPARM) ;Edit an IRT file entry.
L +^VAS(393,+DGJIRTDA):1 I '$T Q
S DR="10.01////"_DGJVDD_";10.02////"_DGJVDB_";10.03////"_DGJVDT_";10.04///"_DGJVTB_";10.05///@;10.06///@;10.07///@;10.08///@"
S DIE="^VAS(393,",DA=DGJIRTDA D ^DIE,STAT1
L -^VAS(393,+DGJIRTDA)
Q
DCSDEL(DGJIRTDA,DGJPARM) ;If DCS is Deleted, IRT Rec should just contain a stub
L +^VAS(393,+DGJIRTDA):1 I '$T Q
S DR="10.01///@;10.02///@;10.03///@;10.04///@;10.05///@;10.06///@;10.07///@;10.08///@"
S DIE="^VAS(393,",DA=DGJIRTDA D ^DIE,STAT1
L -^VAS(393,+DGJIRTDA)
Q
SIGUP(DGJIRTDA,DGJDS,DGJSB,DGJDR,DGJRB,DGJPARM) ;Update Signed and Reviewed fields.
L +^VAS(393,+DGJIRTDA):1 I '$T Q
S DR="10.05////"_DGJDS_";10.06////"_DGJSB_";10.07////"_DGJDR_";10.08////"_DGJRB
S DA=DGJIRTDA,DIE=393 D ^DIE,STAT1
L -^VAS(393,+DGJIRTDA)
Q
STAT1 ;check on the status of the report after a change has been made.
N DGJNODE,DGJSTAT,DGJSTAT1
S DGJNODE=$G(^VAS(393,DGJIRTDA,"DT"))
I $P(DGJNODE,"^",1)']"" S DGJSTAT="INCOMPLETE" G STAT
I $P(DGJNODE,"^",3)']"" S DGJSTAT="DICTATED" G STAT
I $P(DGJNODE,"^",5)']"" S DGJSTAT="TRANSCRIBED" G STAT
I $P(DGJPARM,"^",3)=0 S DGJSTAT="SIGNED NO REVIEW" G STAT
I $P(DGJNODE,"^",7)']"" S DGJSTAT="SIGNED" G STAT
I $P(DGJPARM,"^",3)=1 S DGJSTAT="REVIEWED"
STAT 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
Q
DOC ;provider resp.
S X=$P(DGJPARM,"^",DGJY)
S X=$S(X="A":$P(DGJTSP,"^",19),X="N":"",1:$P(DGJTSP,"^",8))
Q
DGJSUM ;ALB/MAF - Interface routine with Discharge Summary Package - Jan 26 1993
+1 ;;5.3;Registration;**112,1015**;Aug 13, 1993;Build 21
CHECK(DFN,DGJTDT,DGJPARM,DGJIRTDA,DGJT,DGJFLG,DGJTYP) ;Check to see if there is an IRT entry for a deficiency type.
+1 ;Input variables: DFN
+2 ; DGJTDT = Event Date
+3 ; DGJPARM = Division Parameters
+4 ; DGJIRTDA= Incomplete Records IFN
+5 ; DGJT = Array variables
+6 ; DGJT("DIV") = Division
+7 ; DGJT("AD#") = Admission IFN
+8 ; DGJT("WARD")= Ward
+9 ; DGJT("TS") = Treating Specialty
+10 ; DGJT("ADDT") = Admission Date
+11 ; DGJFLG = returns '1' if new entry created
+12 ; (optional) DGJTYP = Pointer to file #393.3 IRT Def. Type
+13 NEW DGJOUT
+14 SET DGJPARM=$GET(^DG(40.8,+$GET(DGJT("DIV")),"DT"))
+15 ;If IRT not turned on
IF '+DGJPARM
QUIT
+16 SET DGJTYP=$GET(DGJTYP,+$ORDER(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))
+17 IF DGJIRTDA]""
IF $DATA(^VAS(393,DGJIRTDA,0))
IF '$DATA(^VAS(393,DGJIRTDA,"DT"))!($DATA(^VAS(393,DGJIRTDA,"DT"))&($PIECE($GET(^("DT")),"^",1)']""))
SET DGJFLG=1
QUIT
+18 IF DGJIRTDA]""
IF $DATA(^VAS(393,DGJIRTDA,0))
QUIT
+19 SET DGJIRTDA=0
FOR
SET DGJIRTDA=$ORDER(^VAS(393,"B",DFN,DGJIRTDA))
IF +DGJIRTDA'>0
QUIT
Begin DoDot:1
+20 IF $PIECE($GET(^VAS(393,DGJIRTDA,0)),"^",2)=DGJTYP
IF $PIECE($GET(^VAS(393,DGJIRTDA,0)),"^",4)=$GET(DGJT("AD#"))
SET DGJOUT=1
QUIT
End DoDot:1
IF +$GET(DGJOUT)
QUIT
+21 IF 'DGJIRTDA
DO ADD
QUIT
+22 QUIT
ADD ;Create an IRT entry
+1 NEW DIC,DLAYGO,DR,DIE,DGJT9,DGJT10,DGJTSP,DGJTSV,DGJX,DGJY,DGJTEV,DGJTWARD
+2 SET DGJTSV=$SELECT($GET(DGJT("WARD"))]"":$PIECE(^DIC(42,+$GET(DGJT("WARD")),0),"^",3),1:"")
+3 IF DGJTSV']""
SET DGJTSV=0
SET DGJTSV=$SELECT($DATA(^DG(393.1,"AC",DGJTSV)):$ORDER(^(DGJTSV,0)),1:"")
IF DGJTSV']""
SET DGJTSV=$ORDER(^DG(393.1,"AC",0,0))
+4 ;last TS mvt
SET DGJTSP=$ORDER(^DGPM("ATS",DFN,+$GET(DGJT("AD#")),0))
SET DGJTSP=$ORDER(^(+DGJTSP,0))
SET DGJTSP=$ORDER(^(+DGJTSP,0))
SET DGJTSP=$SELECT($DATA(^DGPM(+DGJTSP,0)):^(0),1:"")
+5 SET DGJX=8
SET DGJY=2
DO DOC
SET DGJT9=X
SET X=""
+6 SET DGJT10=""
IF $PIECE(DGJPARM,"^",3)
SET DGJX=19
SET DGJY=4
DO DOC
SET DGJT10=X
+7 SET DGJTEV=$SELECT(DGJTDT]"":DGJTDT,1:$PIECE(DGJT("ADDT"),"^",1))
SET DGJTWARD=$GET(^DIC(42,$PIECE($GET(DGJT("WARD")),"^",1),44))
+8 SET DIC="^VAS(393,"
SET DLAYGO=393
SET DIC(0)="L"
SET X=DFN
DO FILE^DICN
+9 SET DGJIRTDA=+Y
IF +Y'>0
QUIT
+10 LOCK +^VAS(393,+DGJIRTDA):1
IF '$TEST
QUIT
+11 SET DR=".02////"_DGJTYP_";.03////"_DGJTEV_";.04////"_$GET(DGJT("AD#"))_";.05////"_DGJTWARD_";.06////"_$GET(DGJT("DIV"))_";.07////"_$PIECE($GET(DGJT("TS")),"^",1)_";.08////"_DGJTSV_";.09////"_DGJT9_";.1////"_DGJT10_";.12////"_DGJT9_";.13////1"
+12 SET DIE="^VAS(393,"
SET DA=DGJIRTDA
DO ^DIE
+13 LOCK -^VAS(393,+DGJIRTDA)
+14 SET DGJFLG=1
QUIT
EDIT(DGJIRTDA,DGJVDD,DGJVDB,DGJVDT,DGJVTB,DGJPARM) ;Edit an IRT file entry.
+1 LOCK +^VAS(393,+DGJIRTDA):1
IF '$TEST
QUIT
+2 SET DR="10.01////"_DGJVDD_";10.02////"_DGJVDB_";10.03////"_DGJVDT_";10.04///"_DGJVTB_";10.05///@;10.06///@;10.07///@;10.08///@"
+3 SET DIE="^VAS(393,"
SET DA=DGJIRTDA
DO ^DIE
DO STAT1
+4 LOCK -^VAS(393,+DGJIRTDA)
+5 QUIT
DCSDEL(DGJIRTDA,DGJPARM) ;If DCS is Deleted, IRT Rec should just contain a stub
+1 LOCK +^VAS(393,+DGJIRTDA):1
IF '$TEST
QUIT
+2 SET DR="10.01///@;10.02///@;10.03///@;10.04///@;10.05///@;10.06///@;10.07///@;10.08///@"
+3 SET DIE="^VAS(393,"
SET DA=DGJIRTDA
DO ^DIE
DO STAT1
+4 LOCK -^VAS(393,+DGJIRTDA)
+5 QUIT
SIGUP(DGJIRTDA,DGJDS,DGJSB,DGJDR,DGJRB,DGJPARM) ;Update Signed and Reviewed fields.
+1 LOCK +^VAS(393,+DGJIRTDA):1
IF '$TEST
QUIT
+2 SET DR="10.05////"_DGJDS_";10.06////"_DGJSB_";10.07////"_DGJDR_";10.08////"_DGJRB
+3 SET DA=DGJIRTDA
SET DIE=393
DO ^DIE
DO STAT1
+4 LOCK -^VAS(393,+DGJIRTDA)
+5 QUIT
STAT1 ;check on the status of the report after a change has been made.
+1 NEW DGJNODE,DGJSTAT,DGJSTAT1
+2 SET DGJNODE=$GET(^VAS(393,DGJIRTDA,"DT"))
+3 IF $PIECE(DGJNODE,"^",1)']""
SET DGJSTAT="INCOMPLETE"
GOTO STAT
+4 IF $PIECE(DGJNODE,"^",3)']""
SET DGJSTAT="DICTATED"
GOTO STAT
+5 IF $PIECE(DGJNODE,"^",5)']""
SET DGJSTAT="TRANSCRIBED"
GOTO STAT
+6 IF $PIECE(DGJPARM,"^",3)=0
SET DGJSTAT="SIGNED NO REVIEW"
GOTO STAT
+7 IF $PIECE(DGJNODE,"^",7)']""
SET DGJSTAT="SIGNED"
GOTO STAT
+8 IF $PIECE(DGJPARM,"^",3)=1
SET DGJSTAT="REVIEWED"
STAT SET DGJSTAT1=$ORDER(^DG(393.2,"B",DGJSTAT,0))
SET DIE="^VAS(393,"
SET DA=DGJIRTDA
SET DR=".11////^S X=DGJSTAT1"
DO ^DIE
KILL DR,DIE
KILL DGJSTAT1
+1 QUIT
DOC ;provider resp.
+1 SET X=$PIECE(DGJPARM,"^",DGJY)
+2 SET X=$SELECT(X="A":$PIECE(DGJTSP,"^",19),X="N":"",1:$PIECE(DGJTSP,"^",8))
+3 QUIT
