TIUPNCV3 ;SLC/DJP ;PNs ==> TIU cnv rtns ;5-7-97
;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
ERRORLOG ;Captures information on records that are NOT converted.
S BADREC=1 I '$D(ERRCTR) S ERRCTR=0
S ERRCTR=ERRCTR+1 S $P(^TIU(8925.97,1,0),U,7)=ERRCTR
S ^GMR(121,"ERROR",GMRPIFN)=PROBLEM
Q
;
TITLE ;Defines variables required for Document Definition look-up
; PNT=^GMR(121.2,TIU("TITLE")),0)
; (1)=TITLE * (2)=TYPE * (3) TYPE NARRATIVE
; (4)=INACTIVE * (5) TIU TITLE IEN
S PNT=$G(^GMR(121.2,TIU("TITLE"),0))
I PNT="" S PROBLEM="Progress Note - IFN "_GMRPIFN_": TITLE not defined in ^GMR(121.2 - (broken pointer)." D ERRORLOG K PROBLEM Q
S PNT(5)=$P($G(^GMR(121.2,TIU("TITLE"),1)),U,3)
I PNT(5)'>0 S PROBLEM="Progress Note IFN "_GMRPIFN_": TITLE not defined in ^TIU(8925.1." D ERRORLOG K PROBLEM Q
S PNT(1)=$P($G(PNT),U,1),PNT(2)=$P($G(PNT),U,2),PNT(4)=$P($G(PNT),U,4)
I PNT(1)=""!PNT(2)="" S PROBLEM="Progress Note - IFN "_GMRPIFN_": Incomplete TITLE information in ^GMR(121.2." D ERRORLOG K PROBLEM Q
S X=PNT(2),DIC=121.1,DIC(0)="X,Z" D ^DIC K DIC
I +Y<0 S PROBLEM="Progress Note IFN "_GMRPIFN_": TYPE not defined in ^GMR(121.1 (broken pointer)." D ERRORLOG K PROBLEM Q
S PNT(3)=$P(Y,U,2)
I $P($G(^TIU(8925.1,PNT(5),0)),U,4)'="DOC" S PROBLEM="Progress Note Title: "_PNT(3)_" not defined correctly in ^TIU(8925.1." D ERRORLOG K PROBLEM Q
I PNT(4)'="" S TIU(1701)=PNT(1),X=PNT(2) D TITLESET Q
D TITLESET
Q
;
TITLESET ;Sets pointers for Document Definition
; .01 DOCUMENT TYPE * .04 PARENT DOCUMENT TYPE
; 1506 COSIGNATURE REQUIRED * 1701 SUBJECT (description)
S TIU(.01)=PNT(5),TIUNM=$P(^TIU(8925.1,PNT(5),0),U,1)
S TIU(.04)="",TIU(.04)=$O(^TIU(8925.1,"AD",TIU(.01),TIU(.04)))
K X,Y,DIC
Q
;
STATUS(TIUSTAT) ;Returns DOCUMENT STATUS pointer
N DIC,X,Y
I TIU("MHCONV")="Y" S TIUSTAT="COMPLETED"
S X=TIUSTAT,DIC="^TIU(8925.6,",DIC(0)="X,Z" D ^DIC Q:+Y<1
Q $P(Y,U,1)
;
DXLS(TIUDX) ;Resolves variable DXLS ptr from Final Discharge Note
S P5=""
S P1=$P(TIUDX,";",2) ; Global reference
S P2=$P(TIUDX,";",1) ; IEN
S P3="^"_P1_P2_","_0_")" ;^(0) reference
S P4="^"_P1_P2_",""D"")" ;^("D") reference
I P1["ICD9" D Q P5
.S P5=$P(@P3,U,3)_" ("_$P(@P3,U)_")"
.I P1["YSD" D Q P5
..S P4=$G(@P4) Q:P4']""
..S P5=P4
..S P3=$P($G(@P3),U)
..S:P3]"" P5=P5_" ("_P3_")"
.I P1["DIC" D
..S P5=$P(@P3,U)_" ("_$P(@P3,U,2)_")"
Q P5
;
BEDSEC(TIUBS) ;Resolves D/C Bedsection ptr from the Final Discharge Note
N Y
S Y=$P(^DIC(42,TIUBS,0),U,1)
Q Y
;
ROLLEM ;Rolls back ^GMR(121 entries in ^TIU(8925
K DIR W @IOF W !!?16,"****** ROLL BACK ******"
W !!?5,"This option will delete all progress notes entered"
W !?5,"into ^TIU(8925 from the GMRPN/TIU Conversion. The"
W !?5,"option uses ^DIK to roll back the file. Run time is"
W !?5,"dependent upon the number of entries made during the"
W !?5,"conversion."
W !! S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="YES"
S DIR("?")="^D HELP10^TIUPNCV3" D ^DIR I $D(DIRUT)!(Y=0) Q
W !!?5,"BEGINNING ROLL BACK...",!
S TST=$P($G(^TIU(8925.97,1,2)),U,1),LST=$P($G(^TIU(8925.97,1,2)),U,2)
S DIK="^TIU(8925,"
Q:TST!LST=""
F DA=TST:1:LST D:$P($G(^TIU(8925,DA,13)),U,3)="C" ^DIK
W !!,"ROLLBACK COMPLETED",!
K TST,DIK,LST,DA,TIUDIV
Q
;
HELP10 ;Help text for ROLLBACK prompt
W !!?5,"Press <ret> to continue with roll back of Progress Notes"
W !?5,"entered during the conversion. The rollback will begin and"
W !?5,"based on rollback fields in ^TIU(8925.97, TIU Conversions."
W !!?5,"Enter NO or ""^"" to stop this option."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPNCV3 3618 printed Apr 09, 2024@21:45:58 Page 2
TIUPNCV3 ;SLC/DJP ;PNs ==> TIU cnv rtns ;5-7-97
+1 ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
ERRORLOG ;Captures information on records that are NOT converted.
+1 SET BADREC=1
IF '$DATA(ERRCTR)
SET ERRCTR=0
+2 SET ERRCTR=ERRCTR+1
SET $PIECE(^TIU(8925.97,1,0),U,7)=ERRCTR
+3 SET ^GMR(121,"ERROR",GMRPIFN)=PROBLEM
+4 QUIT
+5 ;
TITLE ;Defines variables required for Document Definition look-up
+1 ; PNT=^GMR(121.2,TIU("TITLE")),0)
+2 ; (1)=TITLE * (2)=TYPE * (3) TYPE NARRATIVE
+3 ; (4)=INACTIVE * (5) TIU TITLE IEN
+4 SET PNT=$GET(^GMR(121.2,TIU("TITLE"),0))
+5 IF PNT=""
SET PROBLEM="Progress Note - IFN "_GMRPIFN_": TITLE not defined in ^GMR(121.2 - (broken pointer)."
DO ERRORLOG
KILL PROBLEM
QUIT
+6 SET PNT(5)=$PIECE($GET(^GMR(121.2,TIU("TITLE"),1)),U,3)
+7 IF PNT(5)'>0
SET PROBLEM="Progress Note IFN "_GMRPIFN_": TITLE not defined in ^TIU(8925.1."
DO ERRORLOG
KILL PROBLEM
QUIT
+8 SET PNT(1)=$PIECE($GET(PNT),U,1)
SET PNT(2)=$PIECE($GET(PNT),U,2)
SET PNT(4)=$PIECE($GET(PNT),U,4)
+9 IF PNT(1)=""!PNT(2)=""
SET PROBLEM="Progress Note - IFN "_GMRPIFN_": Incomplete TITLE information in ^GMR(121.2."
DO ERRORLOG
KILL PROBLEM
QUIT
+10 SET X=PNT(2)
SET DIC=121.1
SET DIC(0)="X,Z"
DO ^DIC
KILL DIC
+11 IF +Y<0
SET PROBLEM="Progress Note IFN "_GMRPIFN_": TYPE not defined in ^GMR(121.1 (broken pointer)."
DO ERRORLOG
KILL PROBLEM
QUIT
+12 SET PNT(3)=$PIECE(Y,U,2)
+13 IF $PIECE($GET(^TIU(8925.1,PNT(5),0)),U,4)'="DOC"
SET PROBLEM="Progress Note Title: "_PNT(3)_" not defined correctly in ^TIU(8925.1."
DO ERRORLOG
KILL PROBLEM
QUIT
+14 IF PNT(4)'=""
SET TIU(1701)=PNT(1)
SET X=PNT(2)
DO TITLESET
QUIT
+15 DO TITLESET
+16 QUIT
+17 ;
TITLESET ;Sets pointers for Document Definition
+1 ; .01 DOCUMENT TYPE * .04 PARENT DOCUMENT TYPE
+2 ; 1506 COSIGNATURE REQUIRED * 1701 SUBJECT (description)
+3 SET TIU(.01)=PNT(5)
SET TIUNM=$PIECE(^TIU(8925.1,PNT(5),0),U,1)
+4 SET TIU(.04)=""
SET TIU(.04)=$ORDER(^TIU(8925.1,"AD",TIU(.01),TIU(.04)))
+5 KILL X,Y,DIC
+6 QUIT
+7 ;
STATUS(TIUSTAT) ;Returns DOCUMENT STATUS pointer
+1 NEW DIC,X,Y
+2 IF TIU("MHCONV")="Y"
SET TIUSTAT="COMPLETED"
+3 SET X=TIUSTAT
SET DIC="^TIU(8925.6,"
SET DIC(0)="X,Z"
DO ^DIC
if +Y<1
QUIT
+4 QUIT $PIECE(Y,U,1)
+5 ;
DXLS(TIUDX) ;Resolves variable DXLS ptr from Final Discharge Note
+1 SET P5=""
+2 ; Global reference
SET P1=$PIECE(TIUDX,";",2)
+3 ; IEN
SET P2=$PIECE(TIUDX,";",1)
+4 ;^(0) reference
SET P3="^"_P1_P2_","_0_")"
+5 ;^("D") reference
SET P4="^"_P1_P2_",""D"")"
+6 IF P1["ICD9"
Begin DoDot:1
+7 SET P5=$PIECE(@P3,U,3)_" ("_$PIECE(@P3,U)_")"
+8 IF P1["YSD"
Begin DoDot:2
+9 SET P4=$GET(@P4)
if P4']""
QUIT
+10 SET P5=P4
+11 SET P3=$PIECE($GET(@P3),U)
+12 if P3]""
SET P5=P5_" ("_P3_")"
End DoDot:2
QUIT P5
+13 IF P1["DIC"
Begin DoDot:2
+14 SET P5=$PIECE(@P3,U)_" ("_$PIECE(@P3,U,2)_")"
End DoDot:2
End DoDot:1
QUIT P5
+15 QUIT P5
+16 ;
BEDSEC(TIUBS) ;Resolves D/C Bedsection ptr from the Final Discharge Note
+1 NEW Y
+2 SET Y=$PIECE(^DIC(42,TIUBS,0),U,1)
+3 QUIT Y
+4 ;
ROLLEM ;Rolls back ^GMR(121 entries in ^TIU(8925
+1 KILL DIR
WRITE @IOF
WRITE !!?16,"****** ROLL BACK ******"
+2 WRITE !!?5,"This option will delete all progress notes entered"
+3 WRITE !?5,"into ^TIU(8925 from the GMRPN/TIU Conversion. The"
+4 WRITE !?5,"option uses ^DIK to roll back the file. Run time is"
+5 WRITE !?5,"dependent upon the number of entries made during the"
+6 WRITE !?5,"conversion."
+7 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="YES"
+8 SET DIR("?")="^D HELP10^TIUPNCV3"
DO ^DIR
IF $DATA(DIRUT)!(Y=0)
QUIT
+9 WRITE !!?5,"BEGINNING ROLL BACK...",!
+10 SET TST=$PIECE($GET(^TIU(8925.97,1,2)),U,1)
SET LST=$PIECE($GET(^TIU(8925.97,1,2)),U,2)
+11 SET DIK="^TIU(8925,"
+12 if TST!LST=""
QUIT
+13 FOR DA=TST:1:LST
if $PIECE($GET(^TIU(8925,DA,13)),U,3)="C"
DO ^DIK
+14 WRITE !!,"ROLLBACK COMPLETED",!
+15 KILL TST,DIK,LST,DA,TIUDIV
+16 QUIT
+17 ;
HELP10 ;Help text for ROLLBACK prompt
+1 WRITE !!?5,"Press <ret> to continue with roll back of Progress Notes"
+2 WRITE !?5,"entered during the conversion. The rollback will begin and"
+3 WRITE !?5,"based on rollback fields in ^TIU(8925.97, TIU Conversions."
+4 WRITE !!?5,"Enter NO or ""^"" to stop this option."
+5 QUIT
+6 ;
