QANCNVIN.m

QANCNVIN ;HISC/GJC-Incident Reporting Convert Incident Names ;2/16/93

VERSION ;;2.0;Incident Reporting;**18**;08/07/1992

 ;

 K DIR S DIR(0)="Y",DIR("B")="Yes"

 S DIR("A",1)="Do you wish to change incident name text which contains"

 S DIR("A")="a comma to a dash" D ^DIR K DIR

 I '+Y D KILL W !,$C(7),"Exiting..." Q

TEST ;Convert ", " to "-"

 W !?5,"CONVERTING OLD INCIDENT TEXT FROM QA(742.1) TO THE"

 W !?5,"NEW INCIDENT TEXT FOR VERSION 3.0 OF INCIDENT REPORTING.",!

 D WAIT^DICD W ! K ^TMP($J) S QANSUB=""

 F  S QANSUB=$O(^QA(742.1,"B",QANSUB)) Q:QANSUB=""  D

 . S QANIEN=+$O(^QA(742.1,"B",QANSUB,0)) Q:QANIEN'>0

 . S QANOTXT=$P($G(^QA(742.1,QANIEN,0)),U)

 . I QANOTXT["," D

 .. S QANNTXT=$$CONVERT^QANCNVIN(QANOTXT)

 .. S DIE="^QA(742.1,",DA=QANIEN,DR=".01///"_QANNTXT

 .. W !?5,"Converting old incident text: "_QANOTXT

 .. W !?5,"To new incident text: "_QANNTXT,!

 .. S QANFLAG=1 D ^DIE K DA,DIE,DR

 W !?5,$S(+$G(QANFLAG):"Conversion complete!",1:"Records need not be converted.")

 W !!,$C(7) K DIR S DIR(0)="Y",DIR("B")="Yes"

 S DIR("A")="Do you wish to delete this routine from the system"

 D ^DIR K DIR

 I +Y S X="QANCNVIN" X ^%ZOSF("DEL")

KILL ;Kill and quit

 K %,%Y,DA,DR,QANFLAG,QANIEN,QANNTXT,QANOTXT

 K QANSUB,X,X1,Y

 Q

CONVERT(X) ;Convert ', ' to '-'

 K X1

 F  S X1=$F(X,", ") Q:'X1  S X=$E(X,0,X1-3)_"-"_$E(X,X1,255)

 Q X

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QANCNVIN   1370     printed  Apr 09, 2024@21:01:22                                                                                                                                                                                                    Page 2

QANCNVIN  ;HISC/GJC-Incident Reporting Convert Incident Names ;2/16/93

VERSION   ;;2.0;Incident Reporting;**18**;08/07/1992

 +1       ;

 +2        KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="Yes"

 +3        SET DIR("A",1)="Do you wish to change incident name text which contains"

 +4        SET DIR("A")="a comma to a dash"

           DO ^DIR

           KILL DIR

 +5        IF '+Y

               DO KILL

               WRITE !,$CHAR(7),"Exiting..."

               QUIT 

TEST      ;Convert ", " to "-"

 +1        WRITE !?5,"CONVERTING OLD INCIDENT TEXT FROM QA(742.1) TO THE"

 +2        WRITE !?5,"NEW INCIDENT TEXT FOR VERSION 3.0 OF INCIDENT REPORTING.",!

 +3        DO WAIT^DICD

           WRITE !

           KILL ^TMP($JOB)

           SET QANSUB=""

 +4        FOR 

               SET QANSUB=$ORDER(^QA(742.1,"B",QANSUB))

               if QANSUB=""

                   QUIT 

               Begin DoDot:1

 +5                SET QANIEN=+$ORDER(^QA(742.1,"B",QANSUB,0))

                   if QANIEN'>0

                       QUIT 

 +6                SET QANOTXT=$PIECE($GET(^QA(742.1,QANIEN,0)),U)

 +7                IF QANOTXT[","

                       Begin DoDot:2

 +8                        SET QANNTXT=$$CONVERT^QANCNVIN(QANOTXT)

 +9                        SET DIE="^QA(742.1,"

                           SET DA=QANIEN

                           SET DR=".01///"_QANNTXT

 +10                       WRITE !?5,"Converting old incident text: "_QANOTXT

 +11                       WRITE !?5,"To new incident text: "_QANNTXT,!

 +12                       SET QANFLAG=1

                           DO ^DIE

                           KILL DA,DIE,DR

                       End DoDot:2

               End DoDot:1

 +13       WRITE !?5,$SELECT(+$GET(QANFLAG):"Conversion complete!",1:"Records need not be converted.")

 +14       WRITE !!,$CHAR(7)

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="Yes"

 +15       SET DIR("A")="Do you wish to delete this routine from the system"

 +16       DO ^DIR

           KILL DIR

 +17       IF +Y

               SET X="QANCNVIN"

               XECUTE ^%ZOSF("DEL")

KILL      ;Kill and quit

 +1        KILL %,%Y,DA,DR,QANFLAG,QANIEN,QANNTXT,QANOTXT

 +2        KILL QANSUB,X,X1,Y

 +3        QUIT 

CONVERT(X) ;Convert ', ' to '-'

 +1        KILL X1

 +2        FOR 

               SET X1=$FIND(X,", ")

               if 'X1

                   QUIT 

               SET X=$EXTRACT(X,0,X1-3)_"-"_$EXTRACT(X,X1,255)

 +3        QUIT X