Routine: DG1043P

DG1043P ;MNT/BJR - REMOVE DGRU INPT PROTOCOL ; Feb 03, 2021@10:43:40

 ;;5.3;Registration;**1043**;Aug 13, 1993;Build 10

 ;References to DEL^XPDPROT supported by ICR #5567

 ;References to OUT^XPDPROT supported by ICR #5567

 ;References to BMES^XPDUTL supported by ICR #10141

 ;References to XREF^XQORM supported by ICR #10140

 ;References to GET1^DIQ supported by ICR #2056

 ;References to GOTLOCAL^XMXAPIG supported by ICR #3006

 ;References to SENDMSG^XMXAPI supported by ICR #2729

EN ;Entry point for DG*5.3*1043 Post Install routine

 D DELPROT

 D DISPROT

 D FNDEWL

DELPROT ;Delete Protocol from List Protocol

 N DGOM,DGMN,DGPROT,DGCHK,DGOP,DGTEXT,XQORM

 F DGOM=1:1 S DGMN=$P($TEXT(MENLST+DGOM),";;",2) Q:DGMN="$$END"  D

 .F DGOP=1:1 S DGPROT=$P($TEXT(PROLST+DGOP),";;",2) Q:DGPROT="$$END"  D

 ..S DGCHK=$$DELETE^XPDPROT(DGMN,DGPROT)

 ..I DGCHK S DGTEXT="The "_DGPROT_" protocol has been deleted from the "_DGMN_" protocol menu." D BMES^XPDUTL(DGTEXT)

 ..I 'DGCHK S DGTEXT="The "_DGPROT_" protocol could not be deleted from the "_DGMN_" protocol menu. It may have already been removed." D BMES^XPDUTL(DGTEXT)

 S XQORM=$O(^ORD(101,"B","DGPM MOVEMENT EVENTS",0))_";ORD(101,"

 D XREF^XQORM ;Force protocol recompile.

DISPROT ;Disable Protocols

 N DGPRTL,DGPR,DGTEXT

 F DGPR=1:1 S DGPRTL=$P($TEXT(DISLST+DGPR),";;",2) Q:DGPRTL="$$END"  D

 .D OUT^XPDPROT(DGPRTL,"DO NOT USE!! - DG*5.3*1043")

 .S DGTEXT="The "_DGPRTL_" protocol has been disabled." D BMES^XPDUTL(DGTEXT)

MENLST ;Protocol list

 ;;DGPM MOVEMENT EVENTS

 ;;$$END

PROLST ;Protocol List

 ;;DGRU INPATIENT CAPTURE

 ;;$$END

DISLST ;Protocols to Disable

 ;;DGRU INPATIENT CAPTURE

 ;;$$END

FNDEWL ;Identify appt request statuses with EWL and send list to SD EWL BACKGROUND UPDATE mail group

 N DGDFN,XMSUB,XMY,XMTEXT,DGTEXT,DGDTE,DGPT,XMDUZ,DGPARAM,DGIEN,DGLN

 S XMSUB="DG*5.3*1043 Post-Install Job Results" ;msg subject

 I $$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY("G.SD EWL BACKGROUND UPDATE")="" ;send message to mail group

 I '$$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE") S XMY($G(DUZ))="" ;msg addressee array

 S XMDUZ=$G(DUZ),DGPARAM("FROM")="DG*5.3*1043 Post-Install"

 S XMTEXT="DGTEXT" ;array containing the text of msg

 S DGLN=1 ;msg line #

 S DGTEXT(DGLN)="DG*5.3*1043 post-install job results."

 S DGLN=2

 S DGTEXT(DGLN)="The Following Wait List Entries need to be scheduled for the following patients.",DGLN=DGLN+1

 S DGTEXT(DGLN)="PATIENT                        STATUS LAST EDITED",DGLN=DGLN+1

 S DGTEXT(DGLN)="----------------------------------------------------------",DGLN=DGLN+1

 S DGDFN=0 F  S DGDFN=$O(^DPT(DGDFN)) Q:'DGDFN  I $P($G(^DPT(DGDFN,1010.16)),U)="E" D

 .S DGIEN=DGDFN+",",DGPT=$$GET1^DIQ(2,DGIEN,.01)

 .S DGPT=DGPT_"                               ",DGPT=$E(DGPT,1,31)

 .S DGDTE=$$GET1^DIQ(2,DGIEN,1010.162)

 .S DGLN=DGLN+1,DGTEXT(DGLN)=DGPT_DGDTE

 D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.DGPARAM,"","")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG1043P   3004     printed  Feb 19, 2025@00:01:11                                                                                                                                                                                                     Page 2

DG1043P   ;MNT/BJR - REMOVE DGRU INPT PROTOCOL ; Feb 03, 2021@10:43:40

 +1       ;;5.3;Registration;**1043**;Aug 13, 1993;Build 10

 +2       ;

 +3        QUIT

 +4       ;References to DEL^XPDPROT supported by ICR #5567

 +5       ;References to OUT^XPDPROT supported by ICR #5567

 +6       ;References to BMES^XPDUTL supported by ICR #10141

 +7       ;References to XREF^XQORM supported by ICR #10140

 +8       ;References to GET1^DIQ supported by ICR #2056

 +9       ;References to GOTLOCAL^XMXAPIG supported by ICR #3006

 +10      ;References to SENDMSG^XMXAPI supported by ICR #2729

 +11      ;

 +12      ;

EN        ;Entry point for DG*5.3*1043 Post Install routine

 +1        DO DELPROT

 +2        DO DISPROT

 +3        DO FNDEWL

 +4        QUIT

DELPROT   ;Delete Protocol from List Protocol

 +1        NEW DGOM,DGMN,DGPROT,DGCHK,DGOP,DGTEXT,XQORM

 +2        FOR DGOM=1:1

               SET DGMN=$PIECE($TEXT(MENLST+DGOM),";;",2)

               if DGMN="$$END"

                   QUIT

               Begin DoDot:1

 +3                FOR DGOP=1:1

                       SET DGPROT=$PIECE($TEXT(PROLST+DGOP),";;",2)

                       if DGPROT="$$END"

                           QUIT

                       Begin DoDot:2

 +4                        SET DGCHK=$$DELETE^XPDPROT(DGMN,DGPROT)

 +5                        IF DGCHK

                               SET DGTEXT="The "_DGPROT_" protocol has been deleted from the "_DGMN_" protocol menu."

                               DO BMES^XPDUTL(DGTEXT)

 +6                        IF 'DGCHK

                               SET DGTEXT="The "_DGPROT_" protocol could not be deleted from the "_DGMN_" protocol menu. It may have already been removed."

                               DO BMES^XPDUTL(DGTEXT)

                       End DoDot:2

               End DoDot:1

 +7        SET XQORM=$ORDER(^ORD(101,"B","DGPM MOVEMENT EVENTS",0))_";ORD(101,"

 +8       ;Force protocol recompile.

           DO XREF^XQORM

 +9        QUIT

 +10      ;

DISPROT   ;Disable Protocols

 +1        NEW DGPRTL,DGPR,DGTEXT

 +2        FOR DGPR=1:1

               SET DGPRTL=$PIECE($TEXT(DISLST+DGPR),";;",2)

               if DGPRTL="$$END"

                   QUIT

               Begin DoDot:1

 +3                DO OUT^XPDPROT(DGPRTL,"DO NOT USE!! - DG*5.3*1043")

 +4                SET DGTEXT="The "_DGPRTL_" protocol has been disabled."

                   DO BMES^XPDUTL(DGTEXT)

               End DoDot:1

 +5        QUIT

MENLST    ;Protocol list

 +1       ;;DGPM MOVEMENT EVENTS

 +2       ;;$$END

 +3       ;

PROLST    ;Protocol List

 +1       ;;DGRU INPATIENT CAPTURE

 +2       ;;$$END

 +3       ;

DISLST    ;Protocols to Disable

 +1       ;;DGRU INPATIENT CAPTURE

 +2       ;;$$END

 +3       ;

FNDEWL    ;Identify appt request statuses with EWL and send list to SD EWL BACKGROUND UPDATE mail group

 +1        NEW DGDFN,XMSUB,XMY,XMTEXT,DGTEXT,DGDTE,DGPT,XMDUZ,DGPARAM,DGIEN,DGLN

 +2       ;msg subject

           SET XMSUB="DG*5.3*1043 Post-Install Job Results"

 +3       ;send message to mail group

           IF $$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE")

               SET XMY("G.SD EWL BACKGROUND UPDATE")=""

 +4       ;msg addressee array

           IF '$$GOTLOCAL^XMXAPIG("SD EWL BACKGROUND UPDATE")

               SET XMY($GET(DUZ))=""

 +5        SET XMDUZ=$GET(DUZ)

           SET DGPARAM("FROM")="DG*5.3*1043 Post-Install"

 +6       ;array containing the text of msg

           SET XMTEXT="DGTEXT"

 +7       ;msg line #

           SET DGLN=1

 +8        SET DGTEXT(DGLN)="DG*5.3*1043 post-install job results."

 +9        SET DGLN=2

 +10       SET DGTEXT(DGLN)="The Following Wait List Entries need to be scheduled for the following patients."

           SET DGLN=DGLN+1

 +11       SET DGTEXT(DGLN)="PATIENT                        STATUS LAST EDITED"

           SET DGLN=DGLN+1

 +12       SET DGTEXT(DGLN)="----------------------------------------------------------"

           SET DGLN=DGLN+1

 +13       SET DGDFN=0

FOR

               SET DGDFN=$ORDER(^DPT(DGDFN))

               if 'DGDFN

                   QUIT

               IF $PIECE($GET(^DPT(DGDFN,1010.16)),U)="E"

                   Begin DoDot:1

 +14                   SET DGIEN=DGDFN+","

                       SET DGPT=$$GET1^DIQ(2,DGIEN,.01)

 +15                   SET DGPT=DGPT_"                               "

                       SET DGPT=$EXTRACT(DGPT,1,31)

 +16                   SET DGDTE=$$GET1^DIQ(2,DGIEN,1010.162)

 +17                   SET DGLN=DGLN+1

                       SET DGTEXT(DGLN)=DGPT_DGDTE

                   End DoDot:1

 +18       DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.DGPARAM,"","")

 +19       QUIT

DG1043P.m