- 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 Feb 18, 2025@23:51:03 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