Routine: TIUPNCV3

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

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

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

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

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."

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPNCV3   3618     printed  Feb 19, 2025@00:09:46                                                                                                                                                                                                    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       ;

TIUPNCV3.m