- 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
