- TIUDIRT ; SLC/SBW - IRT interface routines ;4/30/98@15:11:48
- ;;1.0;TEXT INTEGRATION UTILITIES;**18**;Jun 20, 1997
- SIGNIRT(TIUDA) ; Update SIGNED & REVIEWED fields in IRT Rec
- N DA,DIC,DR,DIQ,TIUPARM,TIUDATA,TIUDS,TIUSB,TIUDR,TIUB,TIUIRTDA,TIUFLG
- N TIUQUIT,DFN,TIUDDT,TIU,TIUDPRM,TIUD12,TIUD15
- D SETUP(TIUDA)
- Q:+$G(TIUQUIT)
- D CHECK^DGJSUM(DFN,TIUDDT,.TIUPARM,.TIUIRTDA,.TIU,.TIUFLG,$P(TIUDPRM(0),U,12))
- Q:'+$G(TIUPARM)!('+$G(TIUIRTDA))
- I +$G(TIUFLG) D UPDATE
- S TIUD12=$G(^TIU(8925,+TIUDA,12)),TIUD15=$G(^TIU(8925,+TIUDA,15))
- S (TIUDS,TIUSB,TIUDR,TIUB)="@"
- D:TIUD15]"" ;If data exist, set variables
- . ;Review data set here so it exist in case there is no signed data
- . S TIUDR=$S($P(TIUD12,U,4)=$P(TIUD12,U,9):$P(TIUD15,U),1:$P(TIUD15,U,7))
- . I TIUDR]"" S TIUB=$S($P(TIUD12,U,4)=$P(TIUD12,U,9):$P(TIUD15,U,2),1:$P(TIUD15,U,8))
- . E S TIUDR="@"
- . ;Signed data included
- . S TIUDS=$P(TIUD15,U)
- . I TIUDS]"" S TIUSB=$P(TIUD15,U,2)
- . E S TIUDS=TIUDR,TIUSB=TIUB ;If no signed data, set to reviewed data
- . I '+$P($G(TIUPARM),U,3) D ;Review data not required
- . . S (TIUDR,TIUB)="@"
- D SIGUP^DGJSUM(TIUIRTDA,TIUDS,TIUSB,TIUDR,TIUB,TIUPARM)
- Q
- UPDTIRT(TIU,TIUDA) ; Update IRT record
- N DA,DIC,DIQ,DR,TIUPARM,TIUIRTDA,DFN,TIUDDT,TIUQUIT,TIUDPRM
- D SETUP(TIUDA)
- Q:+$G(TIUQUIT)
- D CHECK^DGJSUM(DFN,TIUDDT,.TIUPARM,.TIUIRTDA,.TIU,"",$P(TIUDPRM(0),U,12))
- Q:'+$G(TIUPARM)!('+$G(TIUIRTDA))
- UPDATE ; Update the dictation and transcription data in IRT rec
- N TIUDATA,TIUDD,TIUDB,TIUDT,TIUTB
- ;Update IRT pointer in TIU record
- I '+$P($G(^TIU(8925,TIUDA,14)),U,3) S $P(^(14),U,3)=+TIUIRTDA
- S DR="1202;1307;1302;1201;1209"
- S DA=+TIUDA,DIC=8925,DIQ="TIUDATA",DIQ(0)="IE" D EN^DIQ1
- I $D(TIUDATA) D ;If DS Rec exists, set var for update of IRT Rec
- . S TIUDD=TIUDATA(8925,TIUDA,1307,"I"),TIUDB=$G(TIUDATA(8925,TIUDA,1202,"I"))
- . S TIUDT=TIUDATA(8925,TIUDA,1201,"I"),TIUTB=$P($G(^VA(200,+$G(TIUDATA(8925,TIUDA,1302,"I")),0)),U)
- . I TIUTB]"" S TIUTB="P."_TIUTB
- . D EDIT^DGJSUM(TIUIRTDA,TIUDD,TIUDB,TIUDT,TIUTB,TIUPARM)
- E D DCSDEL^DGJSUM(TIUIRTDA,TIUPARM) ;If Document Deleted, IRT deleted
- Q
- DELIRT(TIUDA) ; Deletes activity fields in IRT Rec
- N TIU,TIUPARM,TIUIRTDA,TIUDDT,DFN,TIUDPRM,TIUQUIT
- D SETUP(TIUDA)
- Q:+$G(TIUQUIT)!('+$G(TIUIRTDA))
- D CHECK^DGJSUM(DFN,TIUDDT,.TIUPARM,.TIUIRTDA,.TIU,.TIUFLG,$P(TIUDPRM(0),U,12))
- ; If TIUFLG>0 - IRT rec created in CHECK and don't need to delete
- I +$G(TIUPARM),+$G(TIUIRTDA),'+$G(TIUFLG) D DCSDEL^DGJSUM(TIUIRTDA,TIUPARM)
- Q
- SETUP(TIUDA) ;Set TIU variables for CHECK^DGJSUM
- N TIUDATE,TIUD0,TIUD14,TIUTYP
- ; If patch DG*5.3*112 is not in place, suppress IRT call
- I $T(CHECK^DGJSUM)'[",DGJTYP" S TIUQUIT=1 Q
- S TIUD0=$G(^TIU(8925,TIUDA,0)) I TIUD0']"" S TIUQUIT=1 Q
- S TIUD14=$G(^TIU(8925,TIUDA,14))
- D DOCPRM^TIULC1(+$G(TIUD0),.TIUDPRM,TIUDA)
- I '$D(TIUDPRM(0))!(+$P(TIUD0,U,6)) S TIUQUIT=1 Q
- ; **18** Modified Quit condition to include case where no IRT Deficiency
- ; is specified (even if the IRT interface is ENABLED)
- I $S('+$P(TIUDPRM(0),U,11):1,'+$P(TIUDPRM(0),U,12):1,1:0) S TIUQUIT=1 Q
- S DFN=+$P(TIUD0,U,2),TIUDDT=$P(TIUD0,U,8),TIUIRTDA=+$P(TIUD14,U,3)
- I '$D(TIU)#2 D GETTIU^TIULD(.TIU,TIUDA)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUDIRT 3232 printed Apr 23, 2025@18:54:18 Page 2
- TIUDIRT ; SLC/SBW - IRT interface routines ;4/30/98@15:11:48
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**18**;Jun 20, 1997
- SIGNIRT(TIUDA) ; Update SIGNED & REVIEWED fields in IRT Rec
- +1 NEW DA,DIC,DR,DIQ,TIUPARM,TIUDATA,TIUDS,TIUSB,TIUDR,TIUB,TIUIRTDA,TIUFLG
- +2 NEW TIUQUIT,DFN,TIUDDT,TIU,TIUDPRM,TIUD12,TIUD15
- +3 DO SETUP(TIUDA)
- +4 if +$GET(TIUQUIT)
- QUIT
- +5 DO CHECK^DGJSUM(DFN,TIUDDT,.TIUPARM,.TIUIRTDA,.TIU,.TIUFLG,$PIECE(TIUDPRM(0),U,12))
- +6 if '+$GET(TIUPARM)!('+$GET(TIUIRTDA))
- QUIT
- +7 IF +$GET(TIUFLG)
- DO UPDATE
- +8 SET TIUD12=$GET(^TIU(8925,+TIUDA,12))
- SET TIUD15=$GET(^TIU(8925,+TIUDA,15))
- +9 SET (TIUDS,TIUSB,TIUDR,TIUB)="@"
- +10 ;If data exist, set variables
- if TIUD15]""
- Begin DoDot:1
- +11 ;Review data set here so it exist in case there is no signed data
- +12 SET TIUDR=$SELECT($PIECE(TIUD12,U,4)=$PIECE(TIUD12,U,9):$PIECE(TIUD15,U),1:$PIECE(TIUD15,U,7))
- +13 IF TIUDR]""
- SET TIUB=$SELECT($PIECE(TIUD12,U,4)=$PIECE(TIUD12,U,9):$PIECE(TIUD15,U,2),1:$PIECE(TIUD15,U,8))
- +14 IF '$TEST
- SET TIUDR="@"
- +15 ;Signed data included
- +16 SET TIUDS=$PIECE(TIUD15,U)
- +17 IF TIUDS]""
- SET TIUSB=$PIECE(TIUD15,U,2)
- +18 ;If no signed data, set to reviewed data
- IF '$TEST
- SET TIUDS=TIUDR
- SET TIUSB=TIUB
- +19 ;Review data not required
- IF '+$PIECE($GET(TIUPARM),U,3)
- Begin DoDot:2
- +20 SET (TIUDR,TIUB)="@"
- End DoDot:2
- End DoDot:1
- +21 DO SIGUP^DGJSUM(TIUIRTDA,TIUDS,TIUSB,TIUDR,TIUB,TIUPARM)
- +22 QUIT
- UPDTIRT(TIU,TIUDA) ; Update IRT record
- +1 NEW DA,DIC,DIQ,DR,TIUPARM,TIUIRTDA,DFN,TIUDDT,TIUQUIT,TIUDPRM
- +2 DO SETUP(TIUDA)
- +3 if +$GET(TIUQUIT)
- QUIT
- +4 DO CHECK^DGJSUM(DFN,TIUDDT,.TIUPARM,.TIUIRTDA,.TIU,"",$PIECE(TIUDPRM(0),U,12))
- +5 if '+$GET(TIUPARM)!('+$GET(TIUIRTDA))
- QUIT
- UPDATE ; Update the dictation and transcription data in IRT rec
- +1 NEW TIUDATA,TIUDD,TIUDB,TIUDT,TIUTB
- +2 ;Update IRT pointer in TIU record
- +3 IF '+$PIECE($GET(^TIU(8925,TIUDA,14)),U,3)
- SET $PIECE(^(14),U,3)=+TIUIRTDA
- +4 SET DR="1202;1307;1302;1201;1209"
- +5 SET DA=+TIUDA
- SET DIC=8925
- SET DIQ="TIUDATA"
- SET DIQ(0)="IE"
- DO EN^DIQ1
- +6 ;If DS Rec exists, set var for update of IRT Rec
- IF $DATA(TIUDATA)
- Begin DoDot:1
- +7 SET TIUDD=TIUDATA(8925,TIUDA,1307,"I")
- SET TIUDB=$GET(TIUDATA(8925,TIUDA,1202,"I"))
- +8 SET TIUDT=TIUDATA(8925,TIUDA,1201,"I")
- SET TIUTB=$PIECE($GET(^VA(200,+$GET(TIUDATA(8925,TIUDA,1302,"I")),0)),U)
- +9 IF TIUTB]""
- SET TIUTB="P."_TIUTB
- +10 DO EDIT^DGJSUM(TIUIRTDA,TIUDD,TIUDB,TIUDT,TIUTB,TIUPARM)
- End DoDot:1
- +11 ;If Document Deleted, IRT deleted
- IF '$TEST
- DO DCSDEL^DGJSUM(TIUIRTDA,TIUPARM)
- +12 QUIT
- DELIRT(TIUDA) ; Deletes activity fields in IRT Rec
- +1 NEW TIU,TIUPARM,TIUIRTDA,TIUDDT,DFN,TIUDPRM,TIUQUIT
- +2 DO SETUP(TIUDA)
- +3 if +$GET(TIUQUIT)!('+$GET(TIUIRTDA))
- QUIT
- +4 DO CHECK^DGJSUM(DFN,TIUDDT,.TIUPARM,.TIUIRTDA,.TIU,.TIUFLG,$PIECE(TIUDPRM(0),U,12))
- +5 ; If TIUFLG>0 - IRT rec created in CHECK and don't need to delete
- +6 IF +$GET(TIUPARM)
- IF +$GET(TIUIRTDA)
- IF '+$GET(TIUFLG)
- DO DCSDEL^DGJSUM(TIUIRTDA,TIUPARM)
- +7 QUIT
- SETUP(TIUDA) ;Set TIU variables for CHECK^DGJSUM
- +1 NEW TIUDATE,TIUD0,TIUD14,TIUTYP
- +2 ; If patch DG*5.3*112 is not in place, suppress IRT call
- +3 IF $TEXT(CHECK^DGJSUM)'[",DGJTYP"
- SET TIUQUIT=1
- QUIT
- +4 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
- IF TIUD0']""
- SET TIUQUIT=1
- QUIT
- +5 SET TIUD14=$GET(^TIU(8925,TIUDA,14))
- +6 DO DOCPRM^TIULC1(+$GET(TIUD0),.TIUDPRM,TIUDA)
- +7 IF '$DATA(TIUDPRM(0))!(+$PIECE(TIUD0,U,6))
- SET TIUQUIT=1
- QUIT
- +8 ; **18** Modified Quit condition to include case where no IRT Deficiency
- +9 ; is specified (even if the IRT interface is ENABLED)
- +10 IF $SELECT('+$PIECE(TIUDPRM(0),U,11):1,'+$PIECE(TIUDPRM(0),U,12):1,1:0)
- SET TIUQUIT=1
- QUIT
- +11 SET DFN=+$PIECE(TIUD0,U,2)
- SET TIUDDT=$PIECE(TIUD0,U,8)
- SET TIUIRTDA=+$PIECE(TIUD14,U,3)
- +12 IF '$DATA(TIU)#2
- DO GETTIU^TIULD(.TIU,TIUDA)
- +13 QUIT
