- 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 ---[H[J[2J[HQANCNVIN 1370 printed Mar 13, 2025@21:04:20 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
