- AZCNFDPT ;RPMS/GTH;** CONVERT NAME FORMAT IN ^DPT ** ; 8/23/88 9:24 AM [ 09/06/88 5:04 PM ]
- ;1;AUG 11, 1988
- START W !?5,$P($T(AZCNFDPT),";",3),! K MODE R !,"[R]eport or [C]hange? R//",MODE:$S($D(DTIME):DTIME,1:60) Q:MODE="^"!('$T) G HELPP:MODE="??",HELP:MODE="?" S MODE=$E(MODE_"R") G:"RrCc"'[MODE START S MODE=$S("Cc"[MODE:1,1:0),PRINT=0 G:MODE QSTART
- DEVICE W ! K IOP,%ZIS("B") S %ZIS="FQN" D ^%ZIS K %ZIS I IO="" W !,*7,"No device specified." Q
- I IO=$I,$D(IO("Q"))#2 R !,"Do you really mean queue to this device? NO//",X:360 I "Nn"[$E(X,1) W !!,"Ok, tell me again ..." K IO("Q") G DEVICE
- I $D(IO("Q")) K IO("Q") S PRINT=1,ZTRTN="QSTART^AZCNFDPT",ZTDESC="Name Format in VA PATIENT file." F G="MODE","PRINT" S ZTSAVE(G)=""
- I D ^%ZTLOAD G ENDQ
- I IO=$I G QSTART
- S IOP=IO D ^%ZIS I 'POP S PRINT=1 G QSTART
- W !,*7,"Device ",IO," busy." G DEVICE
- ENDQ K MODE,PRINT,Y,X,DTOUT,DQOUT,DLOUT,DUOUT,DFOUT Q
- QSTART ; ENTRY POINT - TaskMan.
- U IO D:'PRINT WAIT^DICD S X="",PG=0 D:PRINT HDR F I=0:0 S X=$O(^DPT("B",X)) Q:X="" W:'PRINT "." I $F($P(X,",",1)," ") D PROCESS
- W:PRINT @IOF X ^%ZIS("C") K DA,DIE,DFN,DR,ENTRY,I,MODE,PG,PRINT,X,XNEW
- Q
- PROCESS S XNEW=$E(X,1,$F(X," ")-2)_","_$P(X,",",2)_","_$E(X,$F(X," "),$F(X,",")-2),DFN=$O(^(X,"")),ENTRY=$O(^(DFN,""))
- W !,"Node # ",DFN,?20,"old : '",X,"'",!?20,"new : '",XNEW,"'",! I PRINT,$Y>59 D HDR
- Q:'MODE!PRINT R !,"Confirm change <N> ",YN:$S($D(DTIME):DTIME,1:60) S YN=$E(YN_"N") Q:YN="N"
- S DIE="^DPT(",DA=DFN,DR=".01///"_XNEW I ENTRY]"" S DIE=DIE_DFN_",.01,",DA=ENTRY,DA(1)=DFN
- D ^DIE W ?($X+5),"CHANGE COMPLETE.",!
- Q
- HDR S PG=PG+1 W @IOF,!!!,"*** ERRORS IN NAME FORMAT IN VA PATIENT FILE ***",?72,"page ",PG,!! W:'MODE "NOTE: This is a report only. Corrections have not been made.",!
- Q
- HELP W !!,"Type 'R' to report the name format errors in '^DPT'",!,"'C' to report them and to correct them,",!,"'??' for more help.",!
- G START
- HELPP W !!,"This utility reads through the 'B' index of the VA PATIENT file (^DPT),",!,"looking for names that are in an incorrect format, i.e., 'LNAME II,FNAME M',"
- W !," (teknonym out of place) and corrects their format to 'LNAME,FNAME M,II'.",!!,"Correction of a name requires user confirmation.",!
- G START
- ERRORS S DIE="^DPT(277,.01,",DA(1)=277,DA=5,DR=".01///LNAME III,FNAME M" D ^DIE S DIE="^DPT(277,.01,",DA(1)=277,DA=3,DR=".01///JOHNSTON IV,JAMES" D ^DIE S DIE="^DPT(",DA=330,DR=".01///FRI II,BICI" D ^DIE
- Q
- AZCNFDPT ;RPMS/GTH;** CONVERT NAME FORMAT IN ^DPT ** ; 8/23/88 9:24 AM [ 09/06/88 5:04 PM ]
- +1 ;1;AUG 11, 1988
- START WRITE !?5,$PIECE($TEXT(AZCNFDPT),";",3),!
- KILL MODE
- READ !,"[R]eport or [C]hange? R//",MODE:$SELECT($DATA(DTIME):DTIME,1:60)
- IF MODE="^"!('$TEST)
- QUIT
- IF MODE="??"
- GOTO HELPP
- IF MODE="?"
- GOTO HELP
- SET MODE=$EXTRACT(MODE_"R")
- IF "RrCc"'[MODE
- GOTO START
- SET MODE=$SELECT("Cc"[MODE:1,1:0)
- SET PRINT=0
- IF MODE
- GOTO QSTART
- DEVICE WRITE !
- KILL IOP,%ZIS("B")
- SET %ZIS="FQN"
- DO ^%ZIS
- KILL %ZIS
- IF IO=""
- WRITE !,*7,"No device specified."
- QUIT
- +1 IF IO=$IO
- IF $DATA(IO("Q"))#2
- READ !,"Do you really mean queue to this device? NO//",X:360
- IF "Nn"[$EXTRACT(X,1)
- WRITE !!,"Ok, tell me again ..."
- KILL IO("Q")
- GOTO DEVICE
- +2 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET PRINT=1
- SET ZTRTN="QSTART^AZCNFDPT"
- SET ZTDESC="Name Format in VA PATIENT file."
- FOR G="MODE","PRINT"
- SET ZTSAVE(G)=""
- +3 IF $TEST
- DO ^%ZTLOAD
- GOTO ENDQ
- +4 IF IO=$IO
- GOTO QSTART
- +5 SET IOP=IO
- DO ^%ZIS
- IF 'POP
- SET PRINT=1
- GOTO QSTART
- +6 WRITE !,*7,"Device ",IO," busy."
- GOTO DEVICE
- ENDQ KILL MODE,PRINT,Y,X,DTOUT,DQOUT,DLOUT,DUOUT,DFOUT
- QUIT
- QSTART ; ENTRY POINT - TaskMan.
- +1 USE IO
- IF 'PRINT
- DO WAIT^DICD
- SET X=""
- SET PG=0
- IF PRINT
- DO HDR
- FOR I=0:0
- SET X=$ORDER(^DPT("B",X))
- IF X=""
- QUIT
- IF 'PRINT
- WRITE "."
- IF $FIND($PIECE(X,",",1)," ")
- DO PROCESS
- +2 IF PRINT
- WRITE @IOF
- XECUTE ^%ZIS("C")
- KILL DA,DIE,DFN,DR,ENTRY,I,MODE,PG,PRINT,X,XNEW
- +3 QUIT
- PROCESS SET XNEW=$EXTRACT(X,1,$FIND(X," ")-2)_","_$PIECE(X,",",2)_","_$EXTRACT(X,$FIND(X," "),$FIND(X,",")-2)
- SET DFN=$ORDER(^(X,""))
- SET ENTRY=$ORDER(^(DFN,""))
- +1 WRITE !,"Node # ",DFN,?20,"old : '",X,"'",!?20,"new : '",XNEW,"'",!
- IF PRINT
- IF $Y>59
- DO HDR
- +2 IF 'MODE!PRINT
- QUIT
- READ !,"Confirm change <N> ",YN:$SELECT($DATA(DTIME):DTIME,1:60)
- SET YN=$EXTRACT(YN_"N")
- IF YN="N"
- QUIT
- +3 SET DIE="^DPT("
- SET DA=DFN
- SET DR=".01///"_XNEW
- IF ENTRY]""
- SET DIE=DIE_DFN_",.01,"
- SET DA=ENTRY
- SET DA(1)=DFN
- +4 DO ^DIE
- WRITE ?($X+5),"CHANGE COMPLETE.",!
- +5 QUIT
- HDR SET PG=PG+1
- WRITE @IOF,!!!,"*** ERRORS IN NAME FORMAT IN VA PATIENT FILE ***",?72,"page ",PG,!!
- IF 'MODE
- WRITE "NOTE: This is a report only. Corrections have not been made.",!
- +1 QUIT
- HELP WRITE !!,"Type 'R' to report the name format errors in '^DPT'",!,"'C' to report them and to correct them,",!,"'??' for more help.",!
- +1 GOTO START
- HELPP WRITE !!,"This utility reads through the 'B' index of the VA PATIENT file (^DPT),",!,"looking for names that are in an incorrect format, i.e., 'LNAME II,FNAME M',"
- +1 WRITE !," (teknonym out of place) and corrects their format to 'LNAME,FNAME M,II'.",!!,"Correction of a name requires user confirmation.",!
- +2 GOTO START
- ERRORS SET DIE="^DPT(277,.01,"
- SET DA(1)=277
- SET DA=5
- SET DR=".01///LNAME III,FNAME M"
- DO ^DIE
- SET DIE="^DPT(277,.01,"
- SET DA(1)=277
- SET DA=3
- SET DR=".01///JOHNSTON IV,JAMES"
- DO ^DIE
- SET DIE="^DPT("
- SET DA=330
- SET DR=".01///FRI II,BICI"
- DO ^DIE
- +1 QUIT
