DG5393PT.m

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 ---DG5393PT   1644     printed  Apr 09, 2024@21:48:36                                                                                                                                                                                                    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