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 ---[H[J[2J[HSD53A204 2804 printed Nov 22, 2024@17:55:34 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 ;
