PSNPPSNF ;HP/MJE-PPSN update NDF data ; 05 Mar 2014 1:20 PM
;;4.0;NATIONAL DRUG FILE;**513,571**; 30 Oct 98;Build 5
;Reference to ^%ZISH supported by DBIA #2320
;Reference to ^XUTMOPT supported by DBIA #1472
;
;This routine is used to locate and move PPSN NDF update host files into Cache for processing
Q
;
MFIND ;Entry point for menu option PSNUPDT for immediate PPS-N updates
N PSENTER,DIE,DA,DR,ERRCHK,PSIMHERE,PSNLEG,PSNLEGF,PSNHLD2
I $$GET1^DIQ(57.23,1,10,"I")="Y" D Q
.Q:$G(PSNSCJOB)
.W !!,"A PPS-N/NDF file install is already in progress. Please try again later."
.R !!,"Press enter to continue...",PSENTER:120
;
I '$D(^XUSEC("PSN PPS ADMIN",DUZ))&('$G(PSNSCJOB)) D
.W !!,"You do not have the appropriate security key to use this option"
.W !,"please contact your ADPAC to resolve this issue.",!
.S DIR(0)="E",DIR("A")=" Press ENTER to Continue" D ^DIR K DIR
I '$D(^XUSEC("PSN PPS ADMIN",DUZ)) Q
S PSNLEGF="",PSNLEGF=$$LEGACY^PSNPPSDL() I PSNLEGF Q
;
D CHKD^PSNPPSDL ;update Unix directory if needed and create it if entry does not exist.
;
I '$G(PSNSCJOB) D Q:'Y
.W !!!,"Warning: The NDF update should only be done during off duty hours!"
.W !," Installation may take up to 30 minutes, and the following options"
.W !," will automatically be disabled during installation then enabled"
.W !," once installation has completed."
.W !!," * Print A PMI Sheet * Patient Prescription Processing"
.W !," * Release Medication * Reprint an Outpatient Rx Label",!
.K DIRUT,DUOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N."
.S DIR("A")="Are you sure you want to immediately begin an NDF Update" W !
.S DIR("B")="NO"
.D ^DIR
.I 'Y Q
;
FIND ;Get list of files, quit if flag set to disable update function
;I $P(^PS(57.23,1,0),"^",4)=0 Q
N A1,B1,B2,I,X2,X22,II,XX,QUEST,QUIT2,PSRUNCNT,PSGRP,REJFILE,INSFILE
K ^TMP("PSN PPSN PARSED",$J)
N PSNATYP S PSNATYP="",PSNATYP=$P(^PS(59.7,1,10),"^",12)
S A1("PPS_*")="",(PSNFND,PSNFLG,QUIT2,PSRUNCNT)=0,COMM=1
I $D(^TMP("PSN PPSN READ",$J)) K ^TMP("PSN PPSN READ",$J)
S Y=$$LIST^%ZISH($$GETD^PSNFTP(),$NA(A1),$NA(B2))
S I="" F S I=$O(B2(I)) Q:I="" S B1(99999999+(+$P(I,"_",2)))=I
K B2
CKDIR ;
G EXIT:'$D(B1)
I '$G(PSNSCJOB) D QUEST^PSNPPSMS G EXIT:$G(QUIT2)
;
W !,"Please stand-by NDF update processing can take around 30 minutes..."
S DIE="^PS(57.23,",DA=1,DR="10///Y" D ^DIE K DIE,DA,DR
;
S X2="" F S X2=$O(B1(X2)) Q:X2=""!(+$G(REJFILE)) S X22=$G(B1(X2)) D G:COMM=0 EXIT
.I $P(X22,"_")="PPS"&(+$P(X22,"_",2)=$P(^PS(57.23,1,0),"^",3)) D
..S (PSNFND,PSNFLG)=1 S PSNHLD=X22
..D READ I +$G(REJFILE) Q
..I '$G(PSNSCJOB),'+INSFILE Q
..I '$G(PSNSCJOB) D
...W !,"Installation completed"_$S($G(ERRCHK):" with errors. See error mail message",1:"")_".",!
...D CTRKDL^PSNPPSMS("Installation completed"_$S($G(ERRCHK):" with errors. See error mail message",1:"")_".")
..I $O(B1(X2))]"" W:'$G(PSNSCJOB) !,"Purging background work files before starting the next install...",!
..K ^TMP("PSN PPSN READ",$J),^TMP("PSN PPSN PARSED",$J)
I 'PSNFND W !,"There were no PPS-N update files to install.",!
;
EXIT ; Exit point
K DIE,DA,DR
S DIE="^PS(57.23,",DA=1,DR="10///N" D ^DIE K DIE,DA,DR
K A1,B2,B1,^TMP("PSN PPSN READ",$J),^TMP("PSN PPSN PARSED",$J)
K X2,X22,OLDNDF,COMM,I,I1,PSNFLG,PSNFND,PSNHLD,PSNHLD1,XX,OLDNDF,XPDIDTOT
K Z11,Z12,Z13,Z14,Z15,Z16,Z17,Z18,Z19,Z191,Z192,Z193,Z194
K Z21,Z22,Z23,Z24,Z25,Z26,Z27,Z28,Z29,Z291,Z292,Z293,Z294
K Z31,Z32,Z33,Z34,Z35,Z36,Z37,Z38,Z39,Z391,Z392,Z393,Z394
EXIT2 ;
Q
;
READ ;Read in file
S (INSFILE,REJFILE)=""
S REJFILE=$$REJCHK($P(PSNHLD,";")) Q:+REJFILE
S INSFILE=$$INSTCHK($P(PSNHLD,";"))
I '+INSFILE,'$G(PSNSCJOB) W !!,$P(PSNHLD,";")_" has not been installed.",! Q
W:'$G(PSNSCJOB) !!,"Beginning install for "_$P(X22,";"),!
I PSNATYP="N" I $$NDFK(PSNHLD) D NDFKP^PSNPPSNK ;purge NDFK file before install
D XTMP
N XUMF,XPDGREF,NDFOK
S (XUMF,XPDGREF,NDFOK)=1
K CTRLIEN
S CTRLIEN=$O(^PS(57.23,"B","PPSN",""))
K FDA
S (PSNHLD2,FDA(57.231,"+2,"_1_",",.01))=$P(PSNHLD,";")_";"_$P(INSFILE,"^",2)
D UPDATE^DIE("","FDA")
K CTRLXIEN
S CTRLXIEN=$O(^PS(57.23,1,5,"B",$P(PSNHLD,";")_";"_$P(INSFILE,"^",2),""),-1)
K FDA,%
D NOW^%DTC
S FDA(57.231,CTRLXIEN_","_CTRLIEN_",",1)=%
D UPDATE^DIE("","FDA","CTRLIEN")
K FDA
S FDA(57.23,CTRLIEN_",",30)=1
D FILE^DIE("","FDA")
K FDA
;
W:'$G(PSNSCJOB) !,"Importing the Update file into VistA...",!
;write comm here to send message - file found processing has STARTED
N PSERRMSG,PSMSGTXT,PSRGP,XMTEXT,XMY,PSNSITET,PSNZISH
S PSNSITET=$P($G(^PS(59.7,1,10)),"^",12)
D CTRKDL^PSNPPSMS("Install STARTED message sent to PPS-N")
I PSNSITET="P" S COMM=$$SEND^PSNPPSNC("STARTED",$P(PSNHLD,";"),"")
S COMM=1
;
I COMM=0 D Q
.D CTRKDL^PSNPPSMS("Communication with PPS-N system is down or the station number is invalid.")
.S PSERRMSG="Install cannot be completed."
.S PSMSGTXT="Communication with PPS-N system is down or the station number is invalid."
.I '$G(PSNSCJOB) W !,PSERRMSG,!,PSMSGTXT,! R !!,"Press enter to continue...",PSENTER:120
.D MSGTEXT0^PSNFTP($P(PSNHLD,";"),PSERRMSG,.PSMSGTXT)
.S XMTEXT="PSMSGTXT("
.S PSGRP="",PSGRP=$$GET1^DIQ(57.23,1,5) I PSGRP'="" S XMY($$MG^PSNPPSMG(PSGRP))=""
.S PSGRP="",PSGRP=$$GET1^DIQ(57.23,1,6) I PSGRP'="" S XMY($$MG^PSNPPSMG(PSGRP))=""
.N DIFROM D ^XMD
;
S PSNZISH=$NA(^TMP("PSN PPSN READ",$J,1)) S Y=$$FTG^%ZISH($$GETD^PSNFTP(),X22,PSNZISH,3)
;
D CTRKDL^PSNPPSMS("Parsing data and creating TMP file")
W:'$G(PSNSCJOB) !,"Parsing the data...",!
MOVE ;Move data to ^TMP for call to update
;
D CTRKDL^PSNPPSMS("Reading update file into TMP('PSN PPSN READ',$J) global.")
N Z11,Z12,Z13,Z14,Z15,Z16,Z17,Z18,Z19,Z191,Z192,Z193,Z194,Z21,Z22,Z23,Z24,Z25,Z26,Z27,Z28,Z29,Z291,Z292,Z293,Z294,Z31,Z32,Z33,Z34,Z35,Z36,Z37,Z38,Z39,Z391,Z392,Z393,Z394
S (Z11,Z12,Z13,Z14,Z15,Z16,Z17,Z18,Z19,Z191,Z192,Z193,Z194)=0
S (Z21,Z22,Z23,Z24,Z25,Z26,Z27,Z28,Z29,Z291,Z292,Z293,Z294)=0
S (Z31,Z32,Z33,Z34,Z35,Z36,Z37,Z38,Z39,Z391,Z392,Z393,Z394)=0
D PARSE^PSNPPSNP
;
READ2 ;
;- THIS IS WHERE THE CALL TO UPDATE IS ADDED
D CTRKDL^PSNPPSMS("Disabling menu options")
D DISMNU^PSNPPSMS ;disable menu options
D CTRKDL^PSNPPSMS("Storing PMI data")
W:'$G(PSNSCJOB) !,"Storing PMI data...",!
D PMIUPDT^PSNPPSNV
D CTRKDL^PSNPPSMS("PMI data update complete and storing rest of NDF files.")
W:'$G(PSNSCJOB) !,"Storing data into the rest of the NDF files...",!
REDO ;
D ^PSNPPSNU
D CTRKDL^PSNPPSMS("Processing data transactions")
D DATA^PSNPPSNV
I PSNFND S $P(^PS(57.23,1,0),"^",3)=+$P(PSNHLD,"_",3)
COMM ;
N COMM,INSTIEN,COMMCNT,COMMAGN S (ERRCHK,COMM,INSTIEN,COMMCNT,COMMAGN)=""
S INSTIEN=$O(^PS(57.23,1,5,"B",PSNHLD2,INSTIEN),-1)
I INSTIEN'="",$D(^PS(57.23,1,5,INSTIEN,2)) S ERRCHK=1
;write comm here to send message - COMPLETED processing
D CTRKDL^PSNPPSMS("Checking for errors and sending install completion message")
W:'$G(PSNSCJOB) !,"Sending install completion message to PPS-N...",!
COMMAGN ;
I PSNSITET="Q"!(PSNSITET="P") S COMM=$$SEND^PSNPPSNC("COMPLETED",$P(PSNHLD,";"),""),COMMAGN=COMMAGN+1
I PSNSITET="T"!(PSNSITET="S")!(PSNSITET="N") S COMM=1
I 'COMM&(COMMAGN<3) H 3 W !,"Install completion message could not be sent to PPS-N. Trying again... " G COMMAGN
I 'COMM W !,"The install completion message was not accepted by PPS-N. Please contact ",!,"the National Help Desk.",!
I $G(ERRCHK) D IERRMSG^PSNPPSMG G COMM2
I (PSNSITET="Q"!(PSNSITET="P"))&($D(^TMP("PSN PPSN ERR",$J))) D G COMM2
.D CTRKDL^PSNPPSMS("Install completed but completion message was not accepted by PPS-N. Call the National Help Desk.")
.W !,?5,"*****************************************************************"
.W !?5,"ERROR: ",$P(COMM,"^",2)
.W !?13,"The update file completed installation but the completion"
.W !?13,"message was not accepted by PPS-N."
.W !!?13,"Contact the National Help Desk or enter a ticket."
.D COMMSG^PSNPPSMG
.W !,?5,"*****************************************************************"
D SMSG^PSNPPSMG
D CTRKDL^PSNPPSMS("Installed successfully")
K ^XTMP("PSN PPS VERIFY",$J,PSNHLD)
;
COMM2 ;
K FDA
S FDA(57.23,CTRLIEN_",",30)=0
D FILE^DIE("","FDA")
K FDA,%
D NOW^%DTC
S FDA(57.231,CTRLXIEN_","_CTRLIEN_",",2)=%
D UPDATE^DIE("","FDA","CTRLIEN")
K FDA
K ^TMP("PSN PPSN PARSED",$J)
; Restarting options/protocols which were paused
D CTRKDL^PSNPPSMS("Enabling options/protocols")
D RESOP^PSNPPSMS
Q
;
NDF ;Entry point for NDFMS
N PSNPPSNF S PSNPPSNF=1
D MFIND^PSNPPSNF
Q
;
SCHED ;tasked job entry point
N PSNSCJOB
Q:$$GET1^DIQ(57.23,1,10,"I")="Y"
S PSNSCJOB=1
G FIND
Q
;
XTMP ; task monitoring job to report error if update not finished within 1 hour
N PSNOW,PSNOW1,PSNST
S PSNOW=$$NOW^XLFDT,PSNOW1=$$FMADD^XLFDT(PSNOW,1)
S ^XTMP("PSN PPS VERIFY",$J,PSNHLD,0)=PSNOW1_"^"_PSNOW_"^PPS-N Monitoring^"_$J_"^"_PSNHLD_"^"_$G(DUZ)
S PSNST=$$FMADD^XLFDT(PSNOW,0,0,65)
W " Background monitoring started: "
D RESCH^XUTMOPT("PSN PPS INSTALL VERIFY",PSNST,,,"L")
Q
NDFK(PSNHLD) ; flag to proceed with purging NDFK file
N FLG,NODE,PSI S FLG=1
S PSI=$O(^PS(57.23,1,5,"B",PSNHLD,""),-1) I PSI D
. S NODE=$G(^PS(57.23,1,5,PSI)) I '$P(NODE,"^",3) S FLG=0
Q FLG
;
REJCHK(FILE) ; check if the file has been rejected & finalized
;LSTD - Last Download version
;
N NFILE,LSTD,PSI
S (PSI,LSTD)=0
S PSI=$O(^PS(57.23,1,4,"G",$P(FILE,";"),""),-1) I 'PSI Q "0^0"
I PSI S LSTD=$G(^PS(57.23,1,4,"G",$P(FILE,";"),PSI)),NFILE=FILE_";"_LSTD
I $D(^PS(57.23,1,6,"B",NFILE)) D Q PSI_"^"_LSTD
.W !!,"WARNING: File has been rejected and finalized. Install is not allowed for it." D
.W !,?9,"Installation STOPPED"
Q "0^0"
;
INSTCHK(FILE) ; check if the file has been previously installed
;LSTD - Last Download version
;
N NFILE,LSTD,PSI,Y
S (PSI,Y)=0
S PSI=$O(^PS(57.23,1,4,"G",$P(FILE,";"),""),-1) I 'PSI Q "0^1"
I PSI S LSTD=$G(^PS(57.23,1,4,"G",$P(FILE,";"),PSI)),NFILE=FILE_";"_LSTD
I '$D(^PS(57.23,1,5,"B",NFILE)) Q 1_"^"_LSTD
W !!,"WARNING: File has already been installed."
K DIRUT,DUOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N.",DIR("A")="Do you want to proceed with the installation"
S DIR("B")="YES" D ^DIR
Q Y_"^"_LSTD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNPPSNF 10431 printed Nov 22, 2024@17:34:47 Page 2
PSNPPSNF ;HP/MJE-PPSN update NDF data ; 05 Mar 2014 1:20 PM
+1 ;;4.0;NATIONAL DRUG FILE;**513,571**; 30 Oct 98;Build 5
+2 ;Reference to ^%ZISH supported by DBIA #2320
+3 ;Reference to ^XUTMOPT supported by DBIA #1472
+4 ;
+5 ;This routine is used to locate and move PPSN NDF update host files into Cache for processing
+6 QUIT
+7 ;
MFIND ;Entry point for menu option PSNUPDT for immediate PPS-N updates
+1 NEW PSENTER,DIE,DA,DR,ERRCHK,PSIMHERE,PSNLEG,PSNLEGF,PSNHLD2
+2 IF $$GET1^DIQ(57.23,1,10,"I")="Y"
Begin DoDot:1
+3 if $GET(PSNSCJOB)
QUIT
+4 WRITE !!,"A PPS-N/NDF file install is already in progress. Please try again later."
+5 READ !!,"Press enter to continue...",PSENTER:120
End DoDot:1
QUIT
+6 ;
+7 IF '$DATA(^XUSEC("PSN PPS ADMIN",DUZ))&('$GET(PSNSCJOB))
Begin DoDot:1
+8 WRITE !!,"You do not have the appropriate security key to use this option"
+9 WRITE !,"please contact your ADPAC to resolve this issue.",!
+10 SET DIR(0)="E"
SET DIR("A")=" Press ENTER to Continue"
DO ^DIR
KILL DIR
End DoDot:1
+11 IF '$DATA(^XUSEC("PSN PPS ADMIN",DUZ))
QUIT
+12 SET PSNLEGF=""
SET PSNLEGF=$$LEGACY^PSNPPSDL()
IF PSNLEGF
QUIT
+13 ;
+14 ;update Unix directory if needed and create it if entry does not exist.
DO CHKD^PSNPPSDL
+15 ;
+16 IF '$GET(PSNSCJOB)
Begin DoDot:1
+17 WRITE !!!,"Warning: The NDF update should only be done during off duty hours!"
+18 WRITE !," Installation may take up to 30 minutes, and the following options"
+19 WRITE !," will automatically be disabled during installation then enabled"
+20 WRITE !," once installation has completed."
+21 WRITE !!," * Print A PMI Sheet * Patient Prescription Processing"
+22 WRITE !," * Release Medication * Reprint an Outpatient Rx Label",!
+23 KILL DIRUT,DUOUT,DIR,X,Y
SET DIR(0)="Y"
SET DIR("?")="Please enter Y or N."
+24 SET DIR("A")="Are you sure you want to immediately begin an NDF Update"
WRITE !
+25 SET DIR("B")="NO"
+26 DO ^DIR
+27 IF 'Y
QUIT
End DoDot:1
if 'Y
QUIT
+28 ;
FIND ;Get list of files, quit if flag set to disable update function
+1 ;I $P(^PS(57.23,1,0),"^",4)=0 Q
+2 NEW A1,B1,B2,I,X2,X22,II,XX,QUEST,QUIT2,PSRUNCNT,PSGRP,REJFILE,INSFILE
+3 KILL ^TMP("PSN PPSN PARSED",$JOB)
+4 NEW PSNATYP
SET PSNATYP=""
SET PSNATYP=$PIECE(^PS(59.7,1,10),"^",12)
+5 SET A1("PPS_*")=""
SET (PSNFND,PSNFLG,QUIT2,PSRUNCNT)=0
SET COMM=1
+6 IF $DATA(^TMP("PSN PPSN READ",$JOB))
KILL ^TMP("PSN PPSN READ",$JOB)
+7 SET Y=$$LIST^%ZISH($$GETD^PSNFTP(),$NAME(A1),$NAME(B2))
+8 SET I=""
FOR
SET I=$ORDER(B2(I))
if I=""
QUIT
SET B1(99999999+(+$PIECE(I,"_",2)))=I
+9 KILL B2
CKDIR ;
+1 if '$DATA(B1)
GOTO EXIT
+2 IF '$GET(PSNSCJOB)
DO QUEST^PSNPPSMS
if $GET(QUIT2)
GOTO EXIT
+3 ;
+4 WRITE !,"Please stand-by NDF update processing can take around 30 minutes..."
+5 SET DIE="^PS(57.23,"
SET DA=1
SET DR="10///Y"
DO ^DIE
KILL DIE,DA,DR
+6 ;
+7 SET X2=""
FOR
SET X2=$ORDER(B1(X2))
if X2=""!(+$GET(REJFILE))
QUIT
SET X22=$GET(B1(X2))
Begin DoDot:1
+8 IF $PIECE(X22,"_")="PPS"&(+$PIECE(X22,"_",2)=$PIECE(^PS(57.23,1,0),"^",3))
Begin DoDot:2
+9 SET (PSNFND,PSNFLG)=1
SET PSNHLD=X22
+10 DO READ
IF +$GET(REJFILE)
QUIT
+11 IF '$GET(PSNSCJOB)
IF '+INSFILE
QUIT
+12 IF '$GET(PSNSCJOB)
Begin DoDot:3
+13 WRITE !,"Installation completed"_$SELECT($GET(ERRCHK):" with errors. See error mail message",1:"")_".",!
+14 DO CTRKDL^PSNPPSMS("Installation completed"_$SELECT($GET(ERRCHK):" with errors. See error mail message",1:"")_".")
End DoDot:3
+15 IF $ORDER(B1(X2))]""
if '$GET(PSNSCJOB)
WRITE !,"Purging background work files before starting the next install...",!
+16 KILL ^TMP("PSN PPSN READ",$JOB),^TMP("PSN PPSN PARSED",$JOB)
End DoDot:2
End DoDot:1
if COMM=0
GOTO EXIT
+17 IF 'PSNFND
WRITE !,"There were no PPS-N update files to install.",!
+18 ;
EXIT ; Exit point
+1 KILL DIE,DA,DR
+2 SET DIE="^PS(57.23,"
SET DA=1
SET DR="10///N"
DO ^DIE
KILL DIE,DA,DR
+3 KILL A1,B2,B1,^TMP("PSN PPSN READ",$JOB),^TMP("PSN PPSN PARSED",$JOB)
+4 KILL X2,X22,OLDNDF,COMM,I,I1,PSNFLG,PSNFND,PSNHLD,PSNHLD1,XX,OLDNDF,XPDIDTOT
+5 KILL Z11,Z12,Z13,Z14,Z15,Z16,Z17,Z18,Z19,Z191,Z192,Z193,Z194
+6 KILL Z21,Z22,Z23,Z24,Z25,Z26,Z27,Z28,Z29,Z291,Z292,Z293,Z294
+7 KILL Z31,Z32,Z33,Z34,Z35,Z36,Z37,Z38,Z39,Z391,Z392,Z393,Z394
EXIT2 ;
+1 QUIT
+2 ;
READ ;Read in file
+1 SET (INSFILE,REJFILE)=""
+2 SET REJFILE=$$REJCHK($PIECE(PSNHLD,";"))
if +REJFILE
QUIT
+3 SET INSFILE=$$INSTCHK($PIECE(PSNHLD,";"))
+4 IF '+INSFILE
IF '$GET(PSNSCJOB)
WRITE !!,$PIECE(PSNHLD,";")_" has not been installed.",!
QUIT
+5 if '$GET(PSNSCJOB)
WRITE !!,"Beginning install for "_$PIECE(X22,";"),!
+6 ;purge NDFK file before install
IF PSNATYP="N"
IF $$NDFK(PSNHLD)
DO NDFKP^PSNPPSNK
+7 DO XTMP
+8 NEW XUMF,XPDGREF,NDFOK
+9 SET (XUMF,XPDGREF,NDFOK)=1
+10 KILL CTRLIEN
+11 SET CTRLIEN=$ORDER(^PS(57.23,"B","PPSN",""))
+12 KILL FDA
+13 SET (PSNHLD2,FDA(57.231,"+2,"_1_",",.01))=$PIECE(PSNHLD,";")_";"_$PIECE(INSFILE,"^",2)
+14 DO UPDATE^DIE("","FDA")
+15 KILL CTRLXIEN
+16 SET CTRLXIEN=$ORDER(^PS(57.23,1,5,"B",$PIECE(PSNHLD,";")_";"_$PIECE(INSFILE,"^",2),""),-1)
+17 KILL FDA,%
+18 DO NOW^%DTC
+19 SET FDA(57.231,CTRLXIEN_","_CTRLIEN_",",1)=%
+20 DO UPDATE^DIE("","FDA","CTRLIEN")
+21 KILL FDA
+22 SET FDA(57.23,CTRLIEN_",",30)=1
+23 DO FILE^DIE("","FDA")
+24 KILL FDA
+25 ;
+26 if '$GET(PSNSCJOB)
WRITE !,"Importing the Update file into VistA...",!
+27 ;write comm here to send message - file found processing has STARTED
+28 NEW PSERRMSG,PSMSGTXT,PSRGP,XMTEXT,XMY,PSNSITET,PSNZISH
+29 SET PSNSITET=$PIECE($GET(^PS(59.7,1,10)),"^",12)
+30 DO CTRKDL^PSNPPSMS("Install STARTED message sent to PPS-N")
+31 IF PSNSITET="P"
SET COMM=$$SEND^PSNPPSNC("STARTED",$PIECE(PSNHLD,";"),"")
+32 SET COMM=1
+33 ;
+34 IF COMM=0
Begin DoDot:1
+35 DO CTRKDL^PSNPPSMS("Communication with PPS-N system is down or the station number is invalid.")
+36 SET PSERRMSG="Install cannot be completed."
+37 SET PSMSGTXT="Communication with PPS-N system is down or the station number is invalid."
+38 IF '$GET(PSNSCJOB)
WRITE !,PSERRMSG,!,PSMSGTXT,!
READ !!,"Press enter to continue...",PSENTER:120
+39 DO MSGTEXT0^PSNFTP($PIECE(PSNHLD,";"),PSERRMSG,.PSMSGTXT)
+40 SET XMTEXT="PSMSGTXT("
+41 SET PSGRP=""
SET PSGRP=$$GET1^DIQ(57.23,1,5)
IF PSGRP'=""
SET XMY($$MG^PSNPPSMG(PSGRP))=""
+42 SET PSGRP=""
SET PSGRP=$$GET1^DIQ(57.23,1,6)
IF PSGRP'=""
SET XMY($$MG^PSNPPSMG(PSGRP))=""
+43 NEW DIFROM
DO ^XMD
End DoDot:1
QUIT
+44 ;
+45 SET PSNZISH=$NAME(^TMP("PSN PPSN READ",$JOB,1))
SET Y=$$FTG^%ZISH($$GETD^PSNFTP(),X22,PSNZISH,3)
+46 ;
+47 DO CTRKDL^PSNPPSMS("Parsing data and creating TMP file")
+48 if '$GET(PSNSCJOB)
WRITE !,"Parsing the data...",!
MOVE ;Move data to ^TMP for call to update
+1 ;
+2 DO CTRKDL^PSNPPSMS("Reading update file into TMP('PSN PPSN READ',$J) global.")
+3 NEW Z11,Z12,Z13,Z14,Z15,Z16,Z17,Z18,Z19,Z191,Z192,Z193,Z194,Z21,Z22,Z23,Z24,Z25,Z26,Z27,Z28,Z29,Z291,Z292,Z293,Z294,Z31,Z32,Z33,Z34,Z35,Z36,Z37,Z38,Z39,Z391,Z392,Z393,Z394
+4 SET (Z11,Z12,Z13,Z14,Z15,Z16,Z17,Z18,Z19,Z191,Z192,Z193,Z194)=0
+5 SET (Z21,Z22,Z23,Z24,Z25,Z26,Z27,Z28,Z29,Z291,Z292,Z293,Z294)=0
+6 SET (Z31,Z32,Z33,Z34,Z35,Z36,Z37,Z38,Z39,Z391,Z392,Z393,Z394)=0
+7 DO PARSE^PSNPPSNP
+8 ;
READ2 ;
+1 ;- THIS IS WHERE THE CALL TO UPDATE IS ADDED
+2 DO CTRKDL^PSNPPSMS("Disabling menu options")
+3 ;disable menu options
DO DISMNU^PSNPPSMS
+4 DO CTRKDL^PSNPPSMS("Storing PMI data")
+5 if '$GET(PSNSCJOB)
WRITE !,"Storing PMI data...",!
+6 DO PMIUPDT^PSNPPSNV
+7 DO CTRKDL^PSNPPSMS("PMI data update complete and storing rest of NDF files.")
+8 if '$GET(PSNSCJOB)
WRITE !,"Storing data into the rest of the NDF files...",!
REDO ;
+1 DO ^PSNPPSNU
+2 DO CTRKDL^PSNPPSMS("Processing data transactions")
+3 DO DATA^PSNPPSNV
+4 IF PSNFND
SET $PIECE(^PS(57.23,1,0),"^",3)=+$PIECE(PSNHLD,"_",3)
COMM ;
+1 NEW COMM,INSTIEN,COMMCNT,COMMAGN
SET (ERRCHK,COMM,INSTIEN,COMMCNT,COMMAGN)=""
+2 SET INSTIEN=$ORDER(^PS(57.23,1,5,"B",PSNHLD2,INSTIEN),-1)
+3 IF INSTIEN'=""
IF $DATA(^PS(57.23,1,5,INSTIEN,2))
SET ERRCHK=1
+4 ;write comm here to send message - COMPLETED processing
+5 DO CTRKDL^PSNPPSMS("Checking for errors and sending install completion message")
+6 if '$GET(PSNSCJOB)
WRITE !,"Sending install completion message to PPS-N...",!
COMMAGN ;
+1 IF PSNSITET="Q"!(PSNSITET="P")
SET COMM=$$SEND^PSNPPSNC("COMPLETED",$PIECE(PSNHLD,";"),"")
SET COMMAGN=COMMAGN+1
+2 IF PSNSITET="T"!(PSNSITET="S")!(PSNSITET="N")
SET COMM=1
+3 IF 'COMM&(COMMAGN<3)
HANG 3
WRITE !,"Install completion message could not be sent to PPS-N. Trying again... "
GOTO COMMAGN
+4 IF 'COMM
WRITE !,"The install completion message was not accepted by PPS-N. Please contact ",!,"the National Help Desk.",!
+5 IF $GET(ERRCHK)
DO IERRMSG^PSNPPSMG
GOTO COMM2
+6 IF (PSNSITET="Q"!(PSNSITET="P"))&($DATA(^TMP("PSN PPSN ERR",$JOB)))
Begin DoDot:1
+7 DO CTRKDL^PSNPPSMS("Install completed but completion message was not accepted by PPS-N. Call the National Help Desk.")
+8 WRITE !,?5,"*****************************************************************"
+9 WRITE !?5,"ERROR: ",$PIECE(COMM,"^",2)
+10 WRITE !?13,"The update file completed installation but the completion"
+11 WRITE !?13,"message was not accepted by PPS-N."
+12 WRITE !!?13,"Contact the National Help Desk or enter a ticket."
+13 DO COMMSG^PSNPPSMG
+14 WRITE !,?5,"*****************************************************************"
End DoDot:1
GOTO COMM2
+15 DO SMSG^PSNPPSMG
+16 DO CTRKDL^PSNPPSMS("Installed successfully")
+17 KILL ^XTMP("PSN PPS VERIFY",$JOB,PSNHLD)
+18 ;
COMM2 ;
+1 KILL FDA
+2 SET FDA(57.23,CTRLIEN_",",30)=0
+3 DO FILE^DIE("","FDA")
+4 KILL FDA,%
+5 DO NOW^%DTC
+6 SET FDA(57.231,CTRLXIEN_","_CTRLIEN_",",2)=%
+7 DO UPDATE^DIE("","FDA","CTRLIEN")
+8 KILL FDA
+9 KILL ^TMP("PSN PPSN PARSED",$JOB)
+10 ; Restarting options/protocols which were paused
+11 DO CTRKDL^PSNPPSMS("Enabling options/protocols")
+12 DO RESOP^PSNPPSMS
+13 QUIT
+14 ;
NDF ;Entry point for NDFMS
+1 NEW PSNPPSNF
SET PSNPPSNF=1
+2 DO MFIND^PSNPPSNF
+3 QUIT
+4 ;
SCHED ;tasked job entry point
+1 NEW PSNSCJOB
+2 if $$GET1^DIQ(57.23,1,10,"I")="Y"
QUIT
+3 SET PSNSCJOB=1
+4 GOTO FIND
+5 QUIT
+6 ;
XTMP ; task monitoring job to report error if update not finished within 1 hour
+1 NEW PSNOW,PSNOW1,PSNST
+2 SET PSNOW=$$NOW^XLFDT
SET PSNOW1=$$FMADD^XLFDT(PSNOW,1)
+3 SET ^XTMP("PSN PPS VERIFY",$JOB,PSNHLD,0)=PSNOW1_"^"_PSNOW_"^PPS-N Monitoring^"_$JOB_"^"_PSNHLD_"^"_$GET(DUZ)
+4 SET PSNST=$$FMADD^XLFDT(PSNOW,0,0,65)
+5 WRITE " Background monitoring started: "
+6 DO RESCH^XUTMOPT("PSN PPS INSTALL VERIFY",PSNST,,,"L")
+7 QUIT
NDFK(PSNHLD) ; flag to proceed with purging NDFK file
+1 NEW FLG,NODE,PSI
SET FLG=1
+2 SET PSI=$ORDER(^PS(57.23,1,5,"B",PSNHLD,""),-1)
IF PSI
Begin DoDot:1
+3 SET NODE=$GET(^PS(57.23,1,5,PSI))
IF '$PIECE(NODE,"^",3)
SET FLG=0
End DoDot:1
+4 QUIT FLG
+5 ;
REJCHK(FILE) ; check if the file has been rejected & finalized
+1 ;LSTD - Last Download version
+2 ;
+3 NEW NFILE,LSTD,PSI
+4 SET (PSI,LSTD)=0
+5 SET PSI=$ORDER(^PS(57.23,1,4,"G",$PIECE(FILE,";"),""),-1)
IF 'PSI
QUIT "0^0"
+6 IF PSI
SET LSTD=$GET(^PS(57.23,1,4,"G",$PIECE(FILE,";"),PSI))
SET NFILE=FILE_";"_LSTD
+7 IF $DATA(^PS(57.23,1,6,"B",NFILE))
Begin DoDot:1
+8 WRITE !!,"WARNING: File has been rejected and finalized. Install is not allowed for it."
Begin DoDot:2
End DoDot:2
+9 WRITE !,?9,"Installation STOPPED"
End DoDot:1
QUIT PSI_"^"_LSTD
+10 QUIT "0^0"
+11 ;
INSTCHK(FILE) ; check if the file has been previously installed
+1 ;LSTD - Last Download version
+2 ;
+3 NEW NFILE,LSTD,PSI,Y
+4 SET (PSI,Y)=0
+5 SET PSI=$ORDER(^PS(57.23,1,4,"G",$PIECE(FILE,";"),""),-1)
IF 'PSI
QUIT "0^1"
+6 IF PSI
SET LSTD=$GET(^PS(57.23,1,4,"G",$PIECE(FILE,";"),PSI))
SET NFILE=FILE_";"_LSTD
+7 IF '$DATA(^PS(57.23,1,5,"B",NFILE))
QUIT 1_"^"_LSTD
+8 WRITE !!,"WARNING: File has already been installed."
+9 KILL DIRUT,DUOUT,DIR,X,Y
SET DIR(0)="Y"
SET DIR("?")="Please enter Y or N."
SET DIR("A")="Do you want to proceed with the installation"
+10 SET DIR("B")="YES"
DO ^DIR
+11 QUIT Y_"^"_LSTD
