PSNPPSMG ;HP/MJE-PPSN update NDF data ; 05 Mar 2014 1:20 PM
;;4.0;NATIONAL DRUG FILE;**513,565**; 30 Oct 98;Build 16
;Reference to ^PSDRUG supported by DBIA #2352,#221
;
MESSAGE ;
D CTRKDL^PSNPPSMS("Sending DATA UPDATE FOR NDF email")
W:'$G(PSNSCJOB) !,"Sending mail messages...",!
K FDA
S FDA(57.231,CTRLXIEN_","_CTRLIEN_",",6)="MESSAGE"
D UPDATE^DIE("","FDA","CTRLIEN")
K FDA
S FILE=0,GROOT=$NA(^TMP("PSN PPSN PARSED",$J,"DATAO"))
;
S PSNPS=$P($G(^PS(59.7,1,10)),"^",12) I PSNPS'="N" G G1
N MESSC S MESSC=""
F S MESSC=$O(^TMP("PSN PPSN PARSED",$J,"MESSAGE",MESSC)) Q:MESSC="" D
.I MESSC=0 S ^NDFK(5000,1,2,0)=^TMP("PSN PPSN PARSED",$J,"MESSAGE",MESSC) Q
.S ^NDFK(5000,1,2,MESSC,0)=^TMP("PSN PPSN PARSED",$J,"MESSAGE",MESSC)
S MESSC=""
F S MESSC=$O(^TMP("PSN PPSN PARSED",$J,"MESSAGE2",MESSC)) Q:MESSC="" D
.I MESSC=0 S ^NDFK(5000,1,3,0)=^TMP("PSN PPSN PARSED",$J,"MESSAGE2",MESSC) Q
.S ^NDFK(5000,1,3,MESSC,0)=^TMP("PSN PPSN PARSED",$J,"MESSAGE2",MESSC)
;
G1 K ^TMP($J) M ^TMP($J)=^TMP("PSN PPSN PARSED",$J,"MESSAGE") K ^TMP($J,0)
;
GROUP K XMY S X=$G(^TMP("PSN PPSN PARSED",$J,"GROUP")) I X]"" S XMY("G."_X_"@"_^XMB("NETNAME"))=""
S PSNPS=$P($G(^PS(59.7,1,10)),"^",12)
D XMY
S XMSUB="DATA UPDATE FOR NDF"
S XMDUZ="noreply@domain.ext"
S XMTEXT="^TMP($J," N DIFROM D ^XMD
D CTRKDL^PSNPPSMS("Sent email for DATA UPDATE FOR NDF.")
K FDA
S FDA(57.231,CTRLXIEN_","_CTRLIEN_",",6)="MESSAGE2"
D UPDATE^DIE("","FDA","CTRLIEN")
K FDA
K ^TMP($J) M ^TMP($J)=^TMP("PSN PPSN PARSED",$J,"MESSAGE2") K ^TMP($J,0)
K XMY S X=$G(^TMP("PSN PPSN PARSED",$J,"GROUP")) I X]"" S XMY("G."_X_"@"_^XMB("NETNAME"))=""
;
D XMY
D CTRKDL^PSNPPSMS("Sending UPDATED INTERACTIONS and FDA MED GUIDE message")
S XMSUB="UPDATED INTERACTIONS AND FDA MED GUIDE"
S XMDUZ="noreply@domain.ext"
S XMTEXT="^TMP($J," N DIFROM D ^XMD
D CTRKDL^PSNPPSMS("Sent email for UPDATED INTERACTIONS and FDA MED GUIDE.")
K DA
Q
;
COMMSG ;Send error message that comm link with PPSN is not available
K ^TMP("PSN PPSN PARSED",$J,"COMMSG")
N PSNPS,PSMSGTXT,XMY,X,XMSUB,XMTEXT,PSGRP,LNCNT,FIRST,I3,I4,I5,I6,I7,III
S LNCNT=1,FIRST=0,(I3,I4,I5,I6,I7)="",PSNPS=$P($G(^PS(59.7,1,10)),"^",12)
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",1)="*************************************************************************"
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",3)="*************************************************************************"
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",4)="The following file completed installation with error(s)"_$S(PSNPS="Q":" for QA",1:"")_":"
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",5)=""
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",6)=" Update file Name"
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",7)=" -------------------"
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",8)=" "_$P(PSNHLD,";")
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",9)=""
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",10)=""
S LNCNT=10
G:'$D(^TMP("PSN PPSN ERR",$J)) LZ S LNCNT=11 F S I3=$O(^TMP("PSN PPSN ERR",$J,I3)) Q:I3="" D
.F S I4=$O(^TMP("PSN PPSN ERR",$J,I3,I4)) Q:'I4 D
..F S I5=$O(^TMP("PSN PPSN ERR",$J,I3,I4,I5)) Q:I5="" D
...F S I6=$O(^TMP("PSN PPSN ERR",$J,I3,I4,I5,I6)) Q:I6="" D
....F S I7=$O(^TMP("PSN PPSN ERR",$J,I3,I4,I5,I6,I7)) Q:'I7 D
.....S III=$G(^TMP("PSN PPSN ERR",$J,I3,I4,I5,I6,I7)) D
......I FIRST=0 S ^TMP("PSN PPSN PARSED",$J,"COMMSG",LNCNT)="Error Message: " S LNCNT=LNCNT+1,FIRST=1
......S ^TMP("PSN PPSN PARSED",$J,"COMMSG",LNCNT)=$$TRNS(I4,I5,I6) S LNCNT=LNCNT+1
......S ^TMP("PSN PPSN PARSED",$J,"COMMSG",LNCNT)=" "_$P(III,"^")
......S LNCNT=LNCNT+1
LZ I '$D(^TMP("PSN PPSN ERR",$J)) S ^TMP("PSN PPSN PARSED",$J,"COMMSG",LNCNT+1)="Error Message: "_$P(COMM,"^",2)
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",LNCNT+2)=" The update file completed installation but the completion"
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",LNCNT+3)=" message was not accepted by PPS-N."
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",LNCNT+4)=""
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",LNCNT+5)="Contact the National Help Desk or enter a ticket."
S ^TMP("PSN PPSN PARSED",$J,"COMMSG",LNCNT+6)=""
S X=$G(^TMP("PSN PPSN PARSED",$J,"GROUP")) I X]"" S XMY("G."_X_"@"_^XMB("NETNAME"))=""
D XMY
S XMDUZ="noreply@domain.ext"
S XMSUB="ERROR: PPS-N/NDF File "_$P(PSNHLD,";",1)_" INSTALL"
I PSNPS'="" I PSNPS="Q" S XMSUB="ERROR: PPS-N/NDF File "_$P(PSNHLD,";",1)_" INSTALL FOR QA"
S XMTEXT="^TMP(""PSN PPSN PARSED"",$J,""COMMSG"","
N DIFROM D ^XMD
D CTRKDL^PSNPPSMS("Error email sent (COMMSG).")
Q
;
IERRMSG ;Send error message that comm link with PPSN is not available
K ^TMP("PSN PPSN PARSED",$J,"IERRMSG")
Q:INSTIEN=""
Q:'$D(^PS(57.23,1,5,INSTIEN,2,1))
N PSNEDATA,PSNPS,PSMSGTXT,XMY,X,XMSUB,XMTEXT,PSGRP,LNCNT,FIRST,I3,I4,I5,I6,I7,III
S LNCNT=1,FIRST=0,I3="",PSNPS=$P($G(^PS(59.7,1,10)),"^",12)
S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",1)="*************************************************************************"
S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",2)=" Error(s) occurred during the install of "_$P(PSNHLD,";")_$S(PSNPS="Q":" for QA",1:"")_":"
S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",3)="*************************************************************************"
S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",4)=""
S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",5)="The "_$P(PSNHLD,";")_"NDF Update file completed installation with error(s)."
S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",6)="Contact the National Help Desk or enter a ticket."
S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",7)=""
S LNCNT=7
G:'$D(^PS(57.23,1,5,INSTIEN,2)) LZ2
S LNCNT=11,I3=0 F S I3=$O(^PS(57.23,1,5,INSTIEN,2,I3)) Q:I3="" I $D(^PS(57.23,1,5,INSTIEN,2,I3,0)) D
.I FIRST=0 S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",LNCNT)="Error Message(s): " S LNCNT=LNCNT+1,FIRST=1
.S PSNEDATA="",PSNEDATA=^PS(57.23,1,5,INSTIEN,2,I3,0)
.S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",LNCNT)=" File: "_$$LJ^XLFSTR($P(PSNEDATA,"^",2),13," ")_" IEN: "_$$LJ^XLFSTR($P(PSNEDATA,"^",3),13," ")_" Record Type: "_$$LJ^XLFSTR($P(PSNEDATA,"^",4),13," ") S LNCNT=LNCNT+1
.S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",LNCNT)=" Last Record: "_$P(PSNEDATA,"|",2,3) S LNCNT=LNCNT+1
.S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",LNCNT)=" Message: "_$P(PSNEDATA,"^",5) S LNCNT=LNCNT+1
.S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",LNCNT)=" " S LNCNT=LNCNT+1
;
LZ2 ;
S ^TMP("PSN PPSN PARSED",$J,"IERRMSG",LNCNT)="",XMSUB="ERROR: PPS-N/NDF File "_$P(PSNHLD,";",1)_" INSTALL"
S X=$G(^TMP("PSN PPSN PARSED",$J,"GROUP")) I X]"" S XMY("G."_X_"@"_^XMB("NETNAME"))=""
I PSNPS'="",PSNPS="Q" S XMSUB="ERROR: PPS-N/NDF File "_$P(PSNHLD,";",1)_" INSTALL FOR QA"
K XMY S X=$G(^TMP("PSN PPSN PARSED",$J,"GROUP")) I X]"" S XMY("G."_X_"@"_^XMB("NETNAME"))=""
D XMY
S XMDUZ="noreply@domain.ext"
S XMTEXT="^TMP(""PSN PPSN PARSED"",$J,""IERRMSG"","
N DIFROM D ^XMD
D CTRKDL^PSNPPSMS("Install completed with errors and email with errors was sent (IERRMSG).")
Q
;
SMSG ;Send install successful message
K XMY
N PSNPS
;SETUP PRODUCTION OR SQA
K ^TMP("PSN PPSN PARSED",$J,"MSG2")
N PSGRP,PSNFSIZE,PSSIZE,PSFILE,PSWRKDIR,PSOS
S PSWRKDIR=$$GETD^PSNFTP()
S PSNFSIZE=1,PSSIZE=""
S PSOS=$$GETOS^PSNFTP
I +PSOS=3 D UXFSIZE(PSWRKDIR,PSNHLD,.PSSIZE)
I +PSOS'=3 D FILSIZE^PSNFTP2(PSWRKDIR,PSNHLD,.PSSIZE,1)
;
S PSNPS=$P($G(^PS(59.7,1,10)),"^",12)
;
S XMSUB="PPS-N/NDF File "_$P(PSNHLD,";",1)_" INSTALLED"
I PSNPS'="" I PSNPS="Q" S XMSUB=XMSUB_" FOR QA"
S ^TMP("PSN PPSN PARSED",$J,"MSG2",1)="PPS-N/NDF File "_$P(PSNHLD,";",1)_" (Size "_PSSIZE_$S(+PSOS=1:"",+PSOS=3:" bytes",1:"")_")"
S ^TMP("PSN PPSN PARSED",$J,"MSG2",2)="INSTALLED successfully."
D XMY
S XMTEXT="^TMP(""PSN PPSN PARSED"",$J,""MSG2""," N DIFROM D ^XMD
K ^TMP("PSN PPSN PARSED",$J,"MSG2")
K ^TMP($J)
K XMSUB,XMDUZ,XMTEXT
Q
;
DRGMSG ;
W:'$G(PSNSCJOB) !,"Generating mail messages for unmatched/re-matched drugs...",!
D REPORT^PSNPPSNW ; ********************
;
N INDX,LINE,XMZ,PSNPS K ^TMP("PSN",$J) S LINE=1
S ^TMP("PSN",$J,LINE,0)="PPS-N Update File: "_$P(PSNHLD,";",1),LINE=LINE+1,^TMP("PSN",$J,LINE,0)="",LINE=LINE+1
F INDX="A","X","I" D LOAD1^PSNPPSMS
;S XMDUZ="NDF_MANAGER"
S XMDUZ="noreply@domain.ext"
;
S XMSUB="DRUGS UNMATCHED FROM NATIONAL DRUG FILE"
;
S XMTEXT="^TMP(""PSN"",$J,"
K XMY S X=$G(^TMP("PSN PPSN PARSED",$J,"GROUP")) I X]"" S XMY("G."_X_"@"_^XMB("NETNAME"))=""
S PSGRP="",PSGRP=$$GET1^DIQ(57.23,1,5) ;get PPS-N UPDATE CONTROL:LOCAL EMAIL GROUP NAME (57.23:5)
S:PSGRP'="" XMY(PSGRP)=""
;
S PSNPS=$P($G(^PS(59.7,1,10)),"^",12)
D XMY
N DIFROM D ^XMD I $D(XMZ) S DA=XMZ,DIE=3.9,DR="1.7///P;" D ^DIE
;
S FDA(57.231,CTRLXIEN_","_CTRLIEN_",",10)="MESSAGE3"
D UPDATE^DIE("","FDA","CTRLIEN")
K FDA
K ^TMP($J) M ^TMP($J)=^TMP("PSN PPSN PARSED",$J,"MESSAGE3") K ^TMP($J,0)
K XMY S X=$G(^TMP("PSN PPSN PARSED",$J,"GROUP")) I X]"" S XMY("G."_X_"@"_^XMB("NETNAME"))=""
S PSNPS=$P($G(^PS(59.7,1,10)),"^",12)
D XMY
S XMSUB="LOCAL DRUGS REMATCHED TO NDF"
S XMDUZ="noreply@domain.ext"
S XMTEXT="^TMP($J," N DIFROM
D ^XMD
K DIE,DR
Q
UXFSIZE(PSWRKDIR,PSNHLD,PSSIZE) ; get linux file size
N XPV,PSXLOG,PV S PSSIZE=""
S:'$D(PSWRKDIR) PSWRKDIR=$$GETD^PSNFTP()
S XPV="S PV=$ZF(-1,""stat -c%s "_PSWRKDIR_PSNHLD_">"_PSWRKDIR_"PSNSIZE.DAT"")"
X XPV
S PSXLOG="",PSXLOG=$$FTG^%ZISH(PSWRKDIR,"PSNSIZE.DAT",$NA(^TMP("PSNFSIZELOG",$J,1)),3)
I $D(^TMP("PSNFSIZELOG",$J,1)) S PSSIZE=$G(^TMP("PSNFSIZELOG",$J,1)) K ^TMP("PSNFSIZELOG",$J)
D LINUXDEL^PSNFTP(1,PSWRKDIR,"PSNSIZE.DAT")
Q
TRNS(PSNFILE,IEN,PSNFIELD) ; get the label of file/field
N PSNF,FILE,FILENM,FIELD,PSNARR,FLD,FIELDX
S (FIELD,FILE,FILENM,PSNARR,FLD,PSNF)=""
S FILE=PSNFILE,(FIELD,FIELDX)=PSNFIELD
S PSNF=$S($D(^DIC(FILE,0)):$P($G(^DIC(FILE,0)),U),1:"**Wrong file number**")
I FIELD["," S FILENM=$P($G(^DD(FILE,+FIELD,0)),"^"),FILE=+$P($G(^DD(FILE,$P(FIELD,","),0)),"^",2) S:FILE FIELD=$P(FIELD,",",2)
K PSNARR D FIELD^DID(FILE,FIELD,"","LABEL","PSNARR") S FLD=$S(FIELDX[",":FILENM_" >>> ",1:"")_$G(PSNARR("LABEL"))
Q " File: "_$$LJ^XLFSTR(PSNF,13," ")_" IEN#: "_$$LJ^XLFSTR(IEN,13," ")_" Field: "_$$LJ^XLFSTR(FLD,13," ")
;
XMY ;set XMY for mail message
S XMDUZ="noreply@domain.ext"
S DA=0 F S DA=$O(^XUSEC("PSNMGR",DA)) Q:'DA S XMY(DA)=""
I $D(DUZ) S XMY(DUZ)=""
S PSGRP="",PSGRP=$$GET1^DIQ(57.23,1,5) S:PSGRP'="" XMY($$MG(PSGRP))="" ;PRIMARY PPS-N MAIL GROUP
S PSGRP="",PSGRP=$$GET1^DIQ(57.23,1,6) S:PSGRP'="" XMY($$MG(PSGRP))="" ;SECONDARY MAIL GROUP
Q
;
MG(PSNGG) ; look for Mail Group
I $E(PSNGG,1,2)="G." Q:$O(^XMB(3.8,"B",$E(PSNGG,3,99),0)) PSNGG
Q:$O(^XMB(3.8,"B",PSNGG,0)) "G."_PSNGG
Q PSNGG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNPPSMG 10739 printed Mar 13, 2025@21:29:26 Page 2
PSNPPSMG ;HP/MJE-PPSN update NDF data ; 05 Mar 2014 1:20 PM
+1 ;;4.0;NATIONAL DRUG FILE;**513,565**; 30 Oct 98;Build 16
+2 ;Reference to ^PSDRUG supported by DBIA #2352,#221
+3 ;
MESSAGE ;
+1 DO CTRKDL^PSNPPSMS("Sending DATA UPDATE FOR NDF email")
+2 if '$GET(PSNSCJOB)
WRITE !,"Sending mail messages...",!
+3 KILL FDA
+4 SET FDA(57.231,CTRLXIEN_","_CTRLIEN_",",6)="MESSAGE"
+5 DO UPDATE^DIE("","FDA","CTRLIEN")
+6 KILL FDA
+7 SET FILE=0
SET GROOT=$NAME(^TMP("PSN PPSN PARSED",$JOB,"DATAO"))
+8 ;
+9 SET PSNPS=$PIECE($GET(^PS(59.7,1,10)),"^",12)
IF PSNPS'="N"
GOTO G1
+10 NEW MESSC
SET MESSC=""
+11 FOR
SET MESSC=$ORDER(^TMP("PSN PPSN PARSED",$JOB,"MESSAGE",MESSC))
if MESSC=""
QUIT
Begin DoDot:1
+12 IF MESSC=0
SET ^NDFK(5000,1,2,0)=^TMP("PSN PPSN PARSED",$JOB,"MESSAGE",MESSC)
QUIT
+13 SET ^NDFK(5000,1,2,MESSC,0)=^TMP("PSN PPSN PARSED",$JOB,"MESSAGE",MESSC)
End DoDot:1
+14 SET MESSC=""
+15 FOR
SET MESSC=$ORDER(^TMP("PSN PPSN PARSED",$JOB,"MESSAGE2",MESSC))
if MESSC=""
QUIT
Begin DoDot:1
+16 IF MESSC=0
SET ^NDFK(5000,1,3,0)=^TMP("PSN PPSN PARSED",$JOB,"MESSAGE2",MESSC)
QUIT
+17 SET ^NDFK(5000,1,3,MESSC,0)=^TMP("PSN PPSN PARSED",$JOB,"MESSAGE2",MESSC)
End DoDot:1
+18 ;
G1 KILL ^TMP($JOB)
MERGE ^TMP($JOB)=^TMP("PSN PPSN PARSED",$JOB,"MESSAGE")
KILL ^TMP($JOB,0)
+1 ;
GROUP KILL XMY
SET X=$GET(^TMP("PSN PPSN PARSED",$JOB,"GROUP"))
IF X]""
SET XMY("G."_X_"@"_^XMB("NETNAME"))=""
+1 SET PSNPS=$PIECE($GET(^PS(59.7,1,10)),"^",12)
+2 DO XMY
+3 SET XMSUB="DATA UPDATE FOR NDF"
+4 SET XMDUZ="noreply@domain.ext"
+5 SET XMTEXT="^TMP($J,"
NEW DIFROM
DO ^XMD
+6 DO CTRKDL^PSNPPSMS("Sent email for DATA UPDATE FOR NDF.")
+7 KILL FDA
+8 SET FDA(57.231,CTRLXIEN_","_CTRLIEN_",",6)="MESSAGE2"
+9 DO UPDATE^DIE("","FDA","CTRLIEN")
+10 KILL FDA
+11 KILL ^TMP($JOB)
MERGE ^TMP($JOB)=^TMP("PSN PPSN PARSED",$JOB,"MESSAGE2")
KILL ^TMP($JOB,0)
+12 KILL XMY
SET X=$GET(^TMP("PSN PPSN PARSED",$JOB,"GROUP"))
IF X]""
SET XMY("G."_X_"@"_^XMB("NETNAME"))=""
+13 ;
+14 DO XMY
+15 DO CTRKDL^PSNPPSMS("Sending UPDATED INTERACTIONS and FDA MED GUIDE message")
+16 SET XMSUB="UPDATED INTERACTIONS AND FDA MED GUIDE"
+17 SET XMDUZ="noreply@domain.ext"
+18 SET XMTEXT="^TMP($J,"
NEW DIFROM
DO ^XMD
+19 DO CTRKDL^PSNPPSMS("Sent email for UPDATED INTERACTIONS and FDA MED GUIDE.")
+20 KILL DA
+21 QUIT
+22 ;
COMMSG ;Send error message that comm link with PPSN is not available
+1 KILL ^TMP("PSN PPSN PARSED",$JOB,"COMMSG")
+2 NEW PSNPS,PSMSGTXT,XMY,X,XMSUB,XMTEXT,PSGRP,LNCNT,FIRST,I3,I4,I5,I6,I7,III
+3 SET LNCNT=1
SET FIRST=0
SET (I3,I4,I5,I6,I7)=""
SET PSNPS=$PIECE($GET(^PS(59.7,1,10)),"^",12)
+4 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",1)="*************************************************************************"
+5 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",3)="*************************************************************************"
+6 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",4)="The following file completed installation with error(s)"_$SELECT(PSNPS="Q":" for QA",1:"")_":"
+7 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",5)=""
+8 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",6)=" Update file Name"
+9 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",7)=" -------------------"
+10 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",8)=" "_$PIECE(PSNHLD,";")
+11 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",9)=""
+12 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",10)=""
+13 SET LNCNT=10
+14 if '$DATA(^TMP("PSN PPSN ERR",$JOB))
GOTO LZ
SET LNCNT=11
FOR
SET I3=$ORDER(^TMP("PSN PPSN ERR",$JOB,I3))
if I3=""
QUIT
Begin DoDot:1
+15 FOR
SET I4=$ORDER(^TMP("PSN PPSN ERR",$JOB,I3,I4))
if 'I4
QUIT
Begin DoDot:2
+16 FOR
SET I5=$ORDER(^TMP("PSN PPSN ERR",$JOB,I3,I4,I5))
if I5=""
QUIT
Begin DoDot:3
+17 FOR
SET I6=$ORDER(^TMP("PSN PPSN ERR",$JOB,I3,I4,I5,I6))
if I6=""
QUIT
Begin DoDot:4
+18 FOR
SET I7=$ORDER(^TMP("PSN PPSN ERR",$JOB,I3,I4,I5,I6,I7))
if 'I7
QUIT
Begin DoDot:5
+19 SET III=$GET(^TMP("PSN PPSN ERR",$JOB,I3,I4,I5,I6,I7))
Begin DoDot:6
+20 IF FIRST=0
SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",LNCNT)="Error Message: "
SET LNCNT=LNCNT+1
SET FIRST=1
+21 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",LNCNT)=$$TRNS(I4,I5,I6)
SET LNCNT=LNCNT+1
+22 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",LNCNT)=" "_$PIECE(III,"^")
+23 SET LNCNT=LNCNT+1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
LZ IF '$DATA(^TMP("PSN PPSN ERR",$JOB))
SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",LNCNT+1)="Error Message: "_$PIECE(COMM,"^",2)
+1 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",LNCNT+2)=" The update file completed installation but the completion"
+2 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",LNCNT+3)=" message was not accepted by PPS-N."
+3 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",LNCNT+4)=""
+4 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",LNCNT+5)="Contact the National Help Desk or enter a ticket."
+5 SET ^TMP("PSN PPSN PARSED",$JOB,"COMMSG",LNCNT+6)=""
+6 SET X=$GET(^TMP("PSN PPSN PARSED",$JOB,"GROUP"))
IF X]""
SET XMY("G."_X_"@"_^XMB("NETNAME"))=""
+7 DO XMY
+8 SET XMDUZ="noreply@domain.ext"
+9 SET XMSUB="ERROR: PPS-N/NDF File "_$PIECE(PSNHLD,";",1)_" INSTALL"
+10 IF PSNPS'=""
IF PSNPS="Q"
SET XMSUB="ERROR: PPS-N/NDF File "_$PIECE(PSNHLD,";",1)_" INSTALL FOR QA"
+11 SET XMTEXT="^TMP(""PSN PPSN PARSED"",$J,""COMMSG"","
+12 NEW DIFROM
DO ^XMD
+13 DO CTRKDL^PSNPPSMS("Error email sent (COMMSG).")
+14 QUIT
+15 ;
IERRMSG ;Send error message that comm link with PPSN is not available
+1 KILL ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG")
+2 if INSTIEN=""
QUIT
+3 if '$DATA(^PS(57.23,1,5,INSTIEN,2,1))
QUIT
+4 NEW PSNEDATA,PSNPS,PSMSGTXT,XMY,X,XMSUB,XMTEXT,PSGRP,LNCNT,FIRST,I3,I4,I5,I6,I7,III
+5 SET LNCNT=1
SET FIRST=0
SET I3=""
SET PSNPS=$PIECE($GET(^PS(59.7,1,10)),"^",12)
+6 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",1)="*************************************************************************"
+7 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",2)=" Error(s) occurred during the install of "_$PIECE(PSNHLD,";")_$SELECT(PSNPS="Q":" for QA",1:"")_":"
+8 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",3)="*************************************************************************"
+9 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",4)=""
+10 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",5)="The "_$PIECE(PSNHLD,";")_"NDF Update file completed installation with error(s)."
+11 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",6)="Contact the National Help Desk or enter a ticket."
+12 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",7)=""
+13 SET LNCNT=7
+14 if '$DATA(^PS(57.23,1,5,INSTIEN,2))
GOTO LZ2
+15 SET LNCNT=11
SET I3=0
FOR
SET I3=$ORDER(^PS(57.23,1,5,INSTIEN,2,I3))
if I3=""
QUIT
IF $DATA(^PS(57.23,1,5,INSTIEN,2,I3,0))
Begin DoDot:1
+16 IF FIRST=0
SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",LNCNT)="Error Message(s): "
SET LNCNT=LNCNT+1
SET FIRST=1
+17 SET PSNEDATA=""
SET PSNEDATA=^PS(57.23,1,5,INSTIEN,2,I3,0)
+18 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",LNCNT)=" File: "_$$LJ^XLFSTR($PIECE(PSNEDATA,"^",2),13," ")_" IEN: "_$$LJ^XLFSTR($PIECE(PSNEDATA,"^",3),13," ")_" Record Type: "_$$LJ^XLFSTR($PIECE(PSNEDATA,"^",4),13," ")
SET LNCNT=LNCNT+1
+19 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",LNCNT)=" Last Record: "_$PIECE(PSNEDATA,"|",2,3)
SET LNCNT=LNCNT+1
+20 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",LNCNT)=" Message: "_$PIECE(PSNEDATA,"^",5)
SET LNCNT=LNCNT+1
+21 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",LNCNT)=" "
SET LNCNT=LNCNT+1
End DoDot:1
+22 ;
LZ2 ;
+1 SET ^TMP("PSN PPSN PARSED",$JOB,"IERRMSG",LNCNT)=""
SET XMSUB="ERROR: PPS-N/NDF File "_$PIECE(PSNHLD,";",1)_" INSTALL"
+2 SET X=$GET(^TMP("PSN PPSN PARSED",$JOB,"GROUP"))
IF X]""
SET XMY("G."_X_"@"_^XMB("NETNAME"))=""
+3 IF PSNPS'=""
IF PSNPS="Q"
SET XMSUB="ERROR: PPS-N/NDF File "_$PIECE(PSNHLD,";",1)_" INSTALL FOR QA"
+4 KILL XMY
SET X=$GET(^TMP("PSN PPSN PARSED",$JOB,"GROUP"))
IF X]""
SET XMY("G."_X_"@"_^XMB("NETNAME"))=""
+5 DO XMY
+6 SET XMDUZ="noreply@domain.ext"
+7 SET XMTEXT="^TMP(""PSN PPSN PARSED"",$J,""IERRMSG"","
+8 NEW DIFROM
DO ^XMD
+9 DO CTRKDL^PSNPPSMS("Install completed with errors and email with errors was sent (IERRMSG).")
+10 QUIT
+11 ;
SMSG ;Send install successful message
+1 KILL XMY
+2 NEW PSNPS
+3 ;SETUP PRODUCTION OR SQA
+4 KILL ^TMP("PSN PPSN PARSED",$JOB,"MSG2")
+5 NEW PSGRP,PSNFSIZE,PSSIZE,PSFILE,PSWRKDIR,PSOS
+6 SET PSWRKDIR=$$GETD^PSNFTP()
+7 SET PSNFSIZE=1
SET PSSIZE=""
+8 SET PSOS=$$GETOS^PSNFTP
+9 IF +PSOS=3
DO UXFSIZE(PSWRKDIR,PSNHLD,.PSSIZE)
+10 IF +PSOS'=3
DO FILSIZE^PSNFTP2(PSWRKDIR,PSNHLD,.PSSIZE,1)
+11 ;
+12 SET PSNPS=$PIECE($GET(^PS(59.7,1,10)),"^",12)
+13 ;
+14 SET XMSUB="PPS-N/NDF File "_$PIECE(PSNHLD,";",1)_" INSTALLED"
+15 IF PSNPS'=""
IF PSNPS="Q"
SET XMSUB=XMSUB_" FOR QA"
+16 SET ^TMP("PSN PPSN PARSED",$JOB,"MSG2",1)="PPS-N/NDF File "_$PIECE(PSNHLD,";",1)_" (Size "_PSSIZE_$SELECT(+PSOS=1:"",+PSOS=3:" bytes",1:"")_")"
+17 SET ^TMP("PSN PPSN PARSED",$JOB,"MSG2",2)="INSTALLED successfully."
+18 DO XMY
+19 SET XMTEXT="^TMP(""PSN PPSN PARSED"",$J,""MSG2"","
NEW DIFROM
DO ^XMD
+20 KILL ^TMP("PSN PPSN PARSED",$JOB,"MSG2")
+21 KILL ^TMP($JOB)
+22 KILL XMSUB,XMDUZ,XMTEXT
+23 QUIT
+24 ;
DRGMSG ;
+1 if '$GET(PSNSCJOB)
WRITE !,"Generating mail messages for unmatched/re-matched drugs...",!
+2 ; ********************
DO REPORT^PSNPPSNW
+3 ;
+4 NEW INDX,LINE,XMZ,PSNPS
KILL ^TMP("PSN",$JOB)
SET LINE=1
+5 SET ^TMP("PSN",$JOB,LINE,0)="PPS-N Update File: "_$PIECE(PSNHLD,";",1)
SET LINE=LINE+1
SET ^TMP("PSN",$JOB,LINE,0)=""
SET LINE=LINE+1
+6 FOR INDX="A","X","I"
DO LOAD1^PSNPPSMS
+7 ;S XMDUZ="NDF_MANAGER"
+8 SET XMDUZ="noreply@domain.ext"
+9 ;
+10 SET XMSUB="DRUGS UNMATCHED FROM NATIONAL DRUG FILE"
+11 ;
+12 SET XMTEXT="^TMP(""PSN"",$J,"
+13 KILL XMY
SET X=$GET(^TMP("PSN PPSN PARSED",$JOB,"GROUP"))
IF X]""
SET XMY("G."_X_"@"_^XMB("NETNAME"))=""
+14 ;get PPS-N UPDATE CONTROL:LOCAL EMAIL GROUP NAME (57.23:5)
SET PSGRP=""
SET PSGRP=$$GET1^DIQ(57.23,1,5)
+15 if PSGRP'=""
SET XMY(PSGRP)=""
+16 ;
+17 SET PSNPS=$PIECE($GET(^PS(59.7,1,10)),"^",12)
+18 DO XMY
+19 NEW DIFROM
DO ^XMD
IF $DATA(XMZ)
SET DA=XMZ
SET DIE=3.9
SET DR="1.7///P;"
DO ^DIE
+20 ;
+21 SET FDA(57.231,CTRLXIEN_","_CTRLIEN_",",10)="MESSAGE3"
+22 DO UPDATE^DIE("","FDA","CTRLIEN")
+23 KILL FDA
+24 KILL ^TMP($JOB)
MERGE ^TMP($JOB)=^TMP("PSN PPSN PARSED",$JOB,"MESSAGE3")
KILL ^TMP($JOB,0)
+25 KILL XMY
SET X=$GET(^TMP("PSN PPSN PARSED",$JOB,"GROUP"))
IF X]""
SET XMY("G."_X_"@"_^XMB("NETNAME"))=""
+26 SET PSNPS=$PIECE($GET(^PS(59.7,1,10)),"^",12)
+27 DO XMY
+28 SET XMSUB="LOCAL DRUGS REMATCHED TO NDF"
+29 SET XMDUZ="noreply@domain.ext"
+30 SET XMTEXT="^TMP($J,"
NEW DIFROM
+31 DO ^XMD
+32 KILL DIE,DR
+33 QUIT
UXFSIZE(PSWRKDIR,PSNHLD,PSSIZE) ; get linux file size
+1 NEW XPV,PSXLOG,PV
SET PSSIZE=""
+2 if '$DATA(PSWRKDIR)
SET PSWRKDIR=$$GETD^PSNFTP()
+3 SET XPV="S PV=$ZF(-1,""stat -c%s "_PSWRKDIR_PSNHLD_">"_PSWRKDIR_"PSNSIZE.DAT"")"
+4 XECUTE XPV
+5 SET PSXLOG=""
SET PSXLOG=$$FTG^%ZISH(PSWRKDIR,"PSNSIZE.DAT",$NAME(^TMP("PSNFSIZELOG",$JOB,1)),3)
+6 IF $DATA(^TMP("PSNFSIZELOG",$JOB,1))
SET PSSIZE=$GET(^TMP("PSNFSIZELOG",$JOB,1))
KILL ^TMP("PSNFSIZELOG",$JOB)
+7 DO LINUXDEL^PSNFTP(1,PSWRKDIR,"PSNSIZE.DAT")
+8 QUIT
TRNS(PSNFILE,IEN,PSNFIELD) ; get the label of file/field
+1 NEW PSNF,FILE,FILENM,FIELD,PSNARR,FLD,FIELDX
+2 SET (FIELD,FILE,FILENM,PSNARR,FLD,PSNF)=""
+3 SET FILE=PSNFILE
SET (FIELD,FIELDX)=PSNFIELD
+4 SET PSNF=$SELECT($DATA(^DIC(FILE,0)):$PIECE($GET(^DIC(FILE,0)),U),1:"**Wrong file number**")
+5 IF FIELD[","
SET FILENM=$PIECE($GET(^DD(FILE,+FIELD,0)),"^")
SET FILE=+$PIECE($GET(^DD(FILE,$PIECE(FIELD,","),0)),"^",2)
if FILE
SET FIELD=$PIECE(FIELD,",",2)
+6 KILL PSNARR
DO FIELD^DID(FILE,FIELD,"","LABEL","PSNARR")
SET FLD=$SELECT(FIELDX[",":FILENM_" >>> ",1:"")_$GET(PSNARR("LABEL"))
+7 QUIT " File: "_$$LJ^XLFSTR(PSNF,13," ")_" IEN#: "_$$LJ^XLFSTR(IEN,13," ")_" Field: "_$$LJ^XLFSTR(FLD,13," ")
+8 ;
XMY ;set XMY for mail message
+1 SET XMDUZ="noreply@domain.ext"
+2 SET DA=0
FOR
SET DA=$ORDER(^XUSEC("PSNMGR",DA))
if 'DA
QUIT
SET XMY(DA)=""
+3 IF $DATA(DUZ)
SET XMY(DUZ)=""
+4 ;PRIMARY PPS-N MAIL GROUP
SET PSGRP=""
SET PSGRP=$$GET1^DIQ(57.23,1,5)
if PSGRP'=""
SET XMY($$MG(PSGRP))=""
+5 ;SECONDARY MAIL GROUP
SET PSGRP=""
SET PSGRP=$$GET1^DIQ(57.23,1,6)
if PSGRP'=""
SET XMY($$MG(PSGRP))=""
+6 QUIT
+7 ;
MG(PSNGG) ; look for Mail Group
+1 IF $EXTRACT(PSNGG,1,2)="G."
if $ORDER(^XMB(3.8,"B",$EXTRACT(PSNGG,3,99),0))
QUIT PSNGG
+2 if $ORDER(^XMB(3.8,"B",PSNGG,0))
QUIT "G."_PSNGG
+3 QUIT PSNGG
