SD53A204.m

SD53A204 ;ALB/JAM;Part of post-install routine for patch 204;12/1/99@1105

 ;;5.3;Scheduling;**204**;DEC 01, 1999

 ;This post-install will check file 404.52 for invalid .03 field entries

 ;and save to a mail message.

 ;

POST ;Post-init

 N XSCSTOP

 S XSCSTOP=""

 D PROGCHK(.XSCSTOP)

 I XSCSTOP Q

 D MES^XPDUTL(" ")

 D MES^XPDUTL("This installation will generate an e-mail message with")

 D MES^XPDUTL("a list of invalid PRACTITIONER pointers (field #.03)")

 D MES^XPDUTL("from file POSITION ASSIGMENT HISTORY FILE (#404.52)")

 D MES^XPDUTL($$Q(DUZ))

 Q

        ;

PR40452 ;Process file 404.52 for invalid entries in field .03 and 

 ;create message text for mail message

 ;

 N XMY,XMDUZ,XMSUB,XMTEXT,FND

 K ^TMP("PCMM PRACTITIONER",$J),^TMP("SCMSG",$J)

 ;get list of invalid .03 field entries from file 404.52

 S FND=$$LST^SCMCCV5()

 D MAIL

 S XMDUZ=.5,XMY(XMDUZ)=""

 I $G(SCDUZ) S XMY(SCDUZ)=""

 S XMSUB="PCMM PRACTITIONER INCONSISTENCY REPORT"

 S XMTEXT="^TMP(""SCMSG"",$J,"

 D ^XMD

 K ^TMP("PCMM PRACTITIONER",$J),^TMP("SCMSG",$J)

 Q

 ;

MAIL ; Queue report as a MailMan Message.

 N NUM,TXT,I,SCDAT,SCDT,SCTP,SCSTA,SCPRAC,CNT,BL,X,Y

 S NUM=0,$P(BL," ",20)="",CNT=1

 D SET("This message was automatically generated by PCMM patch SD*5.3*204")

 D SET(" ")

 D SET("      INVALID PRACTITIONER POINTERS IN FILE 404.52 REPORT")

 D SET(" ")

 D SET(" ")

 I 'FND D SET("No inconsistencies found.") Q

 D SET("                              EFFECTIVE")

 D SET("IEN #   TEAM POSITION           DATE          PRACT.     STATUS")

 D SET("---------------------------------------------------------------")

 F I=1:1 S NUM=$O(^TMP("PCMM PRACTITIONER",$J,NUM)) Q:'NUM  D

 . S SCDAT=$G(^SCTM(404.52,NUM,0)),Y=$P(SCDAT,U,2) X ^DD("DD") S SCDT=Y

 . S X=$P(SCDAT,U),SCTP=$P($G(^SCTM(404.57,X,0)),U)

 . S SCSTA=$S($P(SCDAT,U,4):"Active",1:"Inactive"),SCPRAC=$P(SCDAT,U,3)

 . S TXT=$E(NUM_BL,1,7)_$E(SCTP_BL,1,21)_" "_$E(SCDT_BL,1,15)

 . S TXT=TXT_"  "_$E(SCPRAC_BL,1,9)_SCSTA

 . D SET(TXT)

 D SET(" ")

 D SET("Total entries found = "_(I-1))

 Q

 ;

SET(TXT) ;Build message array

 S ^TMP("SCMSG",$J,CNT)=TXT

 S CNT=CNT+1

 Q

 ;

PROGCHK(XSCSTOP) ;checks for necessary programmer variables

 ;

 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D

 . D BMES^XPDUTL("*****")

 . D MES^XPDUTL("Your programming variables are not set up properly.")

 . D MES^XPDUTL("Installation aborted.")

 . D MES^XPDUTL("*****")

 . S XSCSTOP=1

 Q

 ;

Q(SCDUZ) ; run job in background

 ; input  = user duz 

 ; output = task #, report via mailman

 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE

 S ZTRTN="PR40452^SD53A204"

 S ZTDESC="PCMM PRACTITIONER INCONSISTENCY REPORT"

 S ZTDTH=$H

 S ZTIO=""

 S ZTSAVE("SCDUZ")=""

 D ^%ZTLOAD

 Q $S(+ZTSK:": Queued - Task# "_ZTSK,1:": Not Queued!")

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SD53A204   2804     printed  Feb 19, 2025@00:12:04                                                                                                                                                                                                    Page 2

SD53A204  ;ALB/JAM;Part of post-install routine for patch 204;12/1/99@1105

 +1       ;;5.3;Scheduling;**204**;DEC 01, 1999

 +2       ;This post-install will check file 404.52 for invalid .03 field entries

 +3       ;and save to a mail message.

 +4       ;

POST      ;Post-init

 +1        NEW XSCSTOP

 +2        SET XSCSTOP=""

 +3        DO PROGCHK(.XSCSTOP)

 +4        IF XSCSTOP

               QUIT 

 +5        DO MES^XPDUTL(" ")

 +6        DO MES^XPDUTL("This installation will generate an e-mail message with")

 +7        DO MES^XPDUTL("a list of invalid PRACTITIONER pointers (field #.03)")

 +8        DO MES^XPDUTL("from file POSITION ASSIGMENT HISTORY FILE (#404.52)")

 +9        DO MES^XPDUTL($$Q(DUZ))

 +10       QUIT 

 +11      ;

PR40452   ;Process file 404.52 for invalid entries in field .03 and 

 +1       ;create message text for mail message

 +2       ;

 +3        NEW XMY,XMDUZ,XMSUB,XMTEXT,FND

 +4        KILL ^TMP("PCMM PRACTITIONER",$JOB),^TMP("SCMSG",$JOB)

 +5       ;get list of invalid .03 field entries from file 404.52

 +6        SET FND=$$LST^SCMCCV5()

 +7        DO MAIL

 +8        SET XMDUZ=.5

           SET XMY(XMDUZ)=""

 +9        IF $GET(SCDUZ)

               SET XMY(SCDUZ)=""

 +10       SET XMSUB="PCMM PRACTITIONER INCONSISTENCY REPORT"

 +11       SET XMTEXT="^TMP(""SCMSG"",$J,"

 +12       DO ^XMD

 +13       KILL ^TMP("PCMM PRACTITIONER",$JOB),^TMP("SCMSG",$JOB)

 +14       QUIT 

 +15      ;

MAIL      ; Queue report as a MailMan Message.

 +1        NEW NUM,TXT,I,SCDAT,SCDT,SCTP,SCSTA,SCPRAC,CNT,BL,X,Y

 +2        SET NUM=0

           SET $PIECE(BL," ",20)=""

           SET CNT=1

 +3        DO SET("This message was automatically generated by PCMM patch SD*5.3*204")

 +4        DO SET(" ")

 +5        DO SET("      INVALID PRACTITIONER POINTERS IN FILE 404.52 REPORT")

 +6        DO SET(" ")

 +7        DO SET(" ")

 +8        IF 'FND

               DO SET("No inconsistencies found.")

               QUIT 

 +9        DO SET("                              EFFECTIVE")

 +10       DO SET("IEN #   TEAM POSITION           DATE          PRACT.     STATUS")

 +11       DO SET("---------------------------------------------------------------")

 +12       FOR I=1:1

               SET NUM=$ORDER(^TMP("PCMM PRACTITIONER",$JOB,NUM))

               if 'NUM

                   QUIT 

               Begin DoDot:1

 +13               SET SCDAT=$GET(^SCTM(404.52,NUM,0))

                   SET Y=$PIECE(SCDAT,U,2)

                   XECUTE ^DD("DD")

                   SET SCDT=Y

 +14               SET X=$PIECE(SCDAT,U)

                   SET SCTP=$PIECE($GET(^SCTM(404.57,X,0)),U)

 +15               SET SCSTA=$SELECT($PIECE(SCDAT,U,4):"Active",1:"Inactive")

                   SET SCPRAC=$PIECE(SCDAT,U,3)

 +16               SET TXT=$EXTRACT(NUM_BL,1,7)_$EXTRACT(SCTP_BL,1,21)_" "_$EXTRACT(SCDT_BL,1,15)

 +17               SET TXT=TXT_"  "_$EXTRACT(SCPRAC_BL,1,9)_SCSTA

 +18               DO SET(TXT)

               End DoDot:1

 +19       DO SET(" ")

 +20       DO SET("Total entries found = "_(I-1))

 +21       QUIT 

 +22      ;

SET(TXT)  ;Build message array

 +1        SET ^TMP("SCMSG",$JOB,CNT)=TXT

 +2        SET CNT=CNT+1

 +3        QUIT 

 +4       ;

PROGCHK(XSCSTOP) ;checks for necessary programmer variables

 +1       ;

 +2        IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")

               Begin DoDot:1

 +3                DO BMES^XPDUTL("*****")

 +4                DO MES^XPDUTL("Your programming variables are not set up properly.")

 +5                DO MES^XPDUTL("Installation aborted.")

 +6                DO MES^XPDUTL("*****")

 +7                SET XSCSTOP=1

               End DoDot:1

 +8        QUIT 

 +9       ;

Q(SCDUZ)  ; run job in background

 +1       ; input  = user duz 

 +2       ; output = task #, report via mailman

 +3        NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE

 +4        SET ZTRTN="PR40452^SD53A204"

 +5        SET ZTDESC="PCMM PRACTITIONER INCONSISTENCY REPORT"

 +6        SET ZTDTH=$HOROLOG

 +7        SET ZTIO=""

 +8        SET ZTSAVE("SCDUZ")=""

 +9        DO ^%ZTLOAD

 +10       QUIT $SELECT(+ZTSK:": Queued - Task# "_ZTSK,1:": Not Queued!")

 +11      ;