DG53197P.m

DG53197P ;ALB/JDS

 ;;5.3;Patient File;**197**;Aug 13, 1993

 S ^DD(2,.01,"DEL",999999,0)="D DEL^DPTLK2"

 N A S A=$$NEWCP^XPDUTL("DGNAME","POST^DG53197P","")

 Q

POST N Q,G,A,B,C,NAME,Q,DIE,DA,XPDIDTOT,DGUP

 S A=$$PARCP^XPDUTL("DGNAME"),Q="""",XPDIDTOT=27,DGUP=A

 S G="^DPT(""B"","_Q_A_Q_")" D MES^XPDUTL("Checking for Patients with space before comma")

 F  S G=$Q(@G) Q:G'[("B"_Q)  S A=$P(G,Q,4,5) Q:$A(A)>90  S:(DGUP'=$E(A)) B=$$UPCP^XPDUTL("DGNAME",$E(A,1,2)) D:(DGUP'=$E(A)) UPDATE^XPDID($A(A)-64) S DGUP=$E(A) I A[" ," D

 .S DA=+$P(A,Q_",",2),NAME=$P($G(^DPT(DA,0)),U)

 .I NAME[" ," D MES^XPDUTL(NAME) S NAME=$P(NAME," ,")_","_$P(NAME," ,",2,9) K DR S DR=".01////^S X=NAME",DIE=2 D ^DIE D MES^XPDUTL("Change to "_$P($G(^DPT(DA,0)),U))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53197P   748     printed  Apr 09, 2024@22:04:11                                                                                                                                                                                                     Page 2

DG53197P  ;ALB/JDS

 +1       ;;5.3;Patient File;**197**;Aug 13, 1993

 +2        SET ^DD(2,.01,"DEL",999999,0)="D DEL^DPTLK2"

 +3        NEW A

           SET A=$$NEWCP^XPDUTL("DGNAME","POST^DG53197P","")

 +4        QUIT 

POST       NEW Q,G,A,B,C,NAME,Q,DIE,DA,XPDIDTOT,DGUP

 +1        SET A=$$PARCP^XPDUTL("DGNAME")

           SET Q=""""

           SET XPDIDTOT=27

           SET DGUP=A

 +2        SET G="^DPT(""B"","_Q_A_Q_")"

           DO MES^XPDUTL("Checking for Patients with space before comma")

 +3        FOR 

               SET G=$QUERY(@G)

               if G'[("B"_Q)

                   QUIT 

               SET A=$PIECE(G,Q,4,5)

               if $ASCII(A)>90

                   QUIT 

               if (DGUP'=$EXTRACT(A))

                   SET B=$$UPCP^XPDUTL("DGNAME",$EXTRACT(A,1,2))

               if (DGUP'=$EXTRACT(A))

                   DO UPDATE^XPDID($ASCII(A)-64)

               SET DGUP=$EXTRACT(A)

               IF A[" ,"

                   Begin DoDot:1

 +4                    SET DA=+$PIECE(A,Q_",",2)

                       SET NAME=$PIECE($GET(^DPT(DA,0)),U)

 +5                    IF NAME[" ,"

                           DO MES^XPDUTL(NAME)

                           SET NAME=$PIECE(NAME," ,")_","_$PIECE(NAME," ,",2,9)

                           KILL DR

                           SET DR=".01////^S X=NAME"

                           SET DIE=2

                           DO ^DIE

                           DO MES^XPDUTL("Change to "_$PIECE($GET(^DPT(DA,0)),U))

                   End DoDot:1