DG5393PT ;ALB/CMM PATIENT NAME & E NODE CLEANUP POST-INT ;05/09/96
;;5.3;Registration;**93**;Aug 13, 1993
;
;This routine will changes any patient names containing space comma
;to just comma, space space to space, and remove colons and
;semicolons. Also will delete DAYS FOR CANCEL OF SCH ADM parameter
;from MAS PARAMETERS file (#43).
;
POST ;entry point for post-init, setting up checkpoints
N %
S %=$$NEWCP^XPDUTL("DFN","EN^DG5393PT",0)
Q
;
EN ; begin processing
D PTFILE
D PARAM
Q
;
PTFILE ;go through patient file converting patient names containing space
;comma to just comma, space space to space, and remove colons and
;semicolons
N DFN
;
D BMES^XPDUTL(" >> Patient Name & E Node Clean-up")
;
;get value from checkpoints, previous run
S DFN=+$$PARCP^XPDUTL("DFN")
;
LOOP ;
N NAME,NEWNAME,%
F S DFN=$O(^DPT(DFN)) Q:DFN=""!(DFN'?.N) D
.S NAME=$P($G(^DPT(DFN,0)),"^")
.I NAME[" ,"!(NAME[" ")!(NAME[":")!(NAME[";") D
..S NEWNAME=$$CLEAN^DPTLK(NAME),$P(^DPT(DFN,0),"^")=NEWNAME
..K ^DPT("B",$E(NAME,1,30),DFN)
..S DA=DFN,DIK="^DPT(",DIK(1)=".01^B^IVM01" D EN^DIK K DA,DIK
..; ^ reindexes .01 "B" cross reference
.I $D(^DPT(DFN,"E",0)),($O(^(0))']"") K ^DPT(DFN,"E",0)
.; ^ cleanup of erroneous "E" nodes
.S %=$$UPCP^XPDUTL("DFN",DFN)
.; ^ update checkpoint.
Q
;
PARAM ;delete days for sched admit parameter from MAS PARAMETERS file (#43)
N DA,DIK
D BMES^XPDUTL(" >> Deleting DAYS FOR CANCEL OF SCH ADM parameter from MAS PARAMETERS file (#43)")
S DIK="^DD(43,",DA(1)=43,DA=5
D ^DIK
S $P(^DG(43,1,0),"^",6)="" ; delete value if it exists
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG5393PT 1644 printed Dec 13, 2024@02:39:21 Page 2
DG5393PT ;ALB/CMM PATIENT NAME & E NODE CLEANUP POST-INT ;05/09/96
+1 ;;5.3;Registration;**93**;Aug 13, 1993
+2 ;
+3 ;This routine will changes any patient names containing space comma
+4 ;to just comma, space space to space, and remove colons and
+5 ;semicolons. Also will delete DAYS FOR CANCEL OF SCH ADM parameter
+6 ;from MAS PARAMETERS file (#43).
+7 ;
POST ;entry point for post-init, setting up checkpoints
+1 NEW %
+2 SET %=$$NEWCP^XPDUTL("DFN","EN^DG5393PT",0)
+3 QUIT
+4 ;
EN ; begin processing
+1 DO PTFILE
+2 DO PARAM
+3 QUIT
+4 ;
PTFILE ;go through patient file converting patient names containing space
+1 ;comma to just comma, space space to space, and remove colons and
+2 ;semicolons
+3 NEW DFN
+4 ;
+5 DO BMES^XPDUTL(" >> Patient Name & E Node Clean-up")
+6 ;
+7 ;get value from checkpoints, previous run
+8 SET DFN=+$$PARCP^XPDUTL("DFN")
+9 ;
LOOP ;
+1 NEW NAME,NEWNAME,%
+2 FOR
SET DFN=$ORDER(^DPT(DFN))
if DFN=""!(DFN'?.N)
QUIT
Begin DoDot:1
+3 SET NAME=$PIECE($GET(^DPT(DFN,0)),"^")
+4 IF NAME[" ,"!(NAME[" ")!(NAME[":")!(NAME[";")
Begin DoDot:2
+5 SET NEWNAME=$$CLEAN^DPTLK(NAME)
SET $PIECE(^DPT(DFN,0),"^")=NEWNAME
+6 KILL ^DPT("B",$EXTRACT(NAME,1,30),DFN)
+7 SET DA=DFN
SET DIK="^DPT("
SET DIK(1)=".01^B^IVM01"
DO EN^DIK
KILL DA,DIK
+8 ; ^ reindexes .01 "B" cross reference
End DoDot:2
+9 IF $DATA(^DPT(DFN,"E",0))
IF ($ORDER(^(0))']"")
KILL ^DPT(DFN,"E",0)
+10 ; ^ cleanup of erroneous "E" nodes
+11 SET %=$$UPCP^XPDUTL("DFN",DFN)
+12 ; ^ update checkpoint.
End DoDot:1
+13 QUIT
+14 ;
PARAM ;delete days for sched admit parameter from MAS PARAMETERS file (#43)
+1 NEW DA,DIK
+2 DO BMES^XPDUTL(" >> Deleting DAYS FOR CANCEL OF SCH ADM parameter from MAS PARAMETERS file (#43)")
+3 SET DIK="^DD(43,"
SET DA(1)=43
SET DA=5
+4 DO ^DIK
+5 ; delete value if it exists
SET $PIECE(^DG(43,1,0),"^",6)=""
+6 QUIT
